若干年前编的波纹线程序，想要支持UCS和连续运行，不知道如何改了
本帖最后由 meja 于 2023-6-30 21:14 编辑若干年前画水面线用的，不过只能画水平的，今年突然想要改成任意方向都可以，而且要连续输入，突然不会了，求大神帮忙！
;;学习 ssadd函数 2011.6
(defun newerr (NE)
(if (/= NE "Function cancelled")
(princ (strcat "\nError: " NE))
)
(setvar "OSMODE" OM)
(setvar "CMDECHO" CE)
(setvar "BLIPMODE" BM)
(setvar "orthomode" orth)
(princ)
)
(defun c:water
(/ SP EP HT OM CE BM DX AN NX NU AX PX
P1 P2 P3 P4 P5 XSP XEP XT tmpep tmpsp ST EN)
(if (not (tblsearch "LAYER" "water"))
(command "layer" "m" "water" "c" "1" "" ""))
(command "layer" "s" "water" "")
(setvar "ucsfollow" 0)
(setq OM (getvar "OSMODE"))
(setq CE (getvar "CMDECHO"))
(setq BM (getvar "BLIPMODE"))
(setq orth (getvar "orthomode"))
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)
(setvar "orthomode" 1)
(setvar "OSMODE" 1)
(while ; 加入循环
(setq SP (getpoint "\nPick start point of water: "))
(setvar "OSMODE" 0)
(setq EP (getpoint SP "\nPick end point of water: "))
(setq ST SP)
(setq EN (polar SP (ANGLE SP EP) (DISTANCE SP EP)))
(setq XSP (car SP) XEP (car EP))
(if (> XSP XEP)
(progn
(setq tmpsp SP)
(setq tmpep (list(car EP) (cadr SP)))
(setq SP tmpep)
(setq EP tmpsp)
)
)
(setq DX (distance SP EP)
AN (angle SP EP)
NU (/ DX 100)
AX (+ AN (/ pi 2))
P1 (list (+ 20 (car SP)) (- (cadr SP) 20))
P2 (list (+ 40 (car SP)) (- (cadr SP) 30))
P3 (list (+ 60 (car SP)) (- (cadr SP) 30))
P4 (list (+ 80 (car SP)) (- (cadr SP) 20))
P5 (polar SP 0 100)
ss (ssadd) ;;2011.6.27
)
(repeat (fix NU)
(command ".PLINE" SP P1 P2 P3 P4 P5 "")
(setq ss (ssadd (entlast) ss)) ;;2011.6
(setq SP P5
P1 (list (+ 20 (car SP)) (- (cadr SP) 20))
P2 (list (+ 40 (car SP)) (- (cadr SP) 30))
P3 (list (+ 60 (car SP)) (- (cadr SP) 30))
P4 (list (+ 80 (car SP)) (- (cadr SP) 20))
P5 (polar SP 0 100)
)
)
(setq ss (ssadd (entlast) ss)) ;;2011.6.27
(command ".pedit" "m" ss "" "J" 0 "" )
) ;ebd while 结束循环
(setvar "OSMODE" OM)
(setvar "CMDECHO" CE)
(setvar "BLIPMODE" BM)
(setvar "orthomode" orth)
(princ)
);end
本帖最后由 飞雪神光 于 2023-6-30 21:08 编辑
英文提示 错误的代码根本不能运行 无意义的代码段有AI的风格 飞雪神光 发表于 2023-6-30 21:03
英文提示 错误的代码根本不能运行 无意义的代码段有AI的风格
我把我写的无法运行的UCS代码删除了，你再看看。这个代码一定可以运行的！！！ 本帖最后由 飞雪神光 于 2023-6-30 21:43 编辑
(defun c:water (/ *error* an cenpt dx ep lm-arcwith3p nu olducs sp ss)
(defun *error*()
(command "ucs" olducs "")
)
(if (not (tblsearch "layer" "water"))
(entmake(list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")(cons 2 "water")'(62 . 1)'(70 . 0)'(6 . "CONTINUOUS")))
)
(defun lm-arcwith3p (center point1 point2 / rad1 rad2 r)
(setq rad1 (angle center point1))
(setq rad2 (angle center point2))
(setq r (distance center point1))
(entmake (list '(0 . "ARC")
'(100 . "AcDbEntity")
'(67 . 0)
'(100 . "AcDbCircle")
'(8 . "water")
(cons 10 center)
(cons 40 r)
'(100 . "AcDbArc")
(cons 50 rad1)
(cons 51 rad2)
)
)
(entlast)
)
(setq olducs (getvar "UCSORG"))
(command "ucs" "w")
(setvar "peditaccept" 1)
(setvar "cmdecho" 0)
(while (setq sp (getpoint "\n指定波浪线起点:"))
(setq
ep (getpoint sp "\n指定波浪线终点:")
nu (/ (fix(distance sp ep)) 100)
ss (ssadd)
)
(setq xsp (car sp) xep (car ep))
(if (> xsp xep)
(progn
(setq tmpsp sp)
(setq sp ep)
(setq ep tmpsp)
)
)
(setq an (angle sp ep))
(repeat nu
(setq cenpt(polar (polar sp an 50) (+ an (* pi 0.5)) 25))
(setq ss (ssadd (lm-arcwith3p cenpt sp (setq ep(polar sp an 100))) ss))
(setq sp ep)
)
(command ".pedit" "m" ss "" "J" 0 "" )
)
(command "ucs" olducs "")
(princ)
) 飞雪神光 发表于 2023-6-30 21:38
感谢你的指点，仍然存在两个问题
第一，我的原设想是用三段线取代圆弧，不然开始就可以使用圆弧代替
第二，如果连续画线，第二次的起点应该为上次的终点
那你自己改一改就好了 飞雪神光 发表于 2023-6-30 23:58
那你自己改一改就好了
第一条我可以试试，但是第二条我还真不知道怎么进入循环 meja 发表于 2023-7-1 00:28
第一条我可以试试，但是第二条我还真不知道怎么进入循环
(setq sp (getpoint "\n指定波浪线起点:"))
(setq ep (getpoint sp "\n指定波浪线终点:"))
(while ep
(setq ep (getpoint sp "\n指定波浪线终点:"))
) 本帖最后由 meja 于 2023-7-1 17:26 编辑
飞雪神光 发表于 2023-7-1 10:35
(setq sp (getpoint "\n指定波浪线起点:"))
(while ep
(setq ep (getpoint sp "\n指定波浪线终点:"))
)
页:
[1]