若干年前编的波纹线程序，想要支持UCS和连续运行，不知道如何改了

meja

若干年前画水面线用的，不过只能画水平的，今年突然想要改成任意方向都可以，而且要连续输入，突然不会了，求大神帮忙！

2. ;;学习 ssadd函数 2011.6
   
3. (defun newerr (NE)
   
4.    (if (/= NE "Function cancelled")
   
5.       (princ (strcat "\nError: " NE))
   
6.    )
   
7.    (setvar "OSMODE" OM)
   
8.    (setvar "CMDECHO" CE)
   
9.    (setvar "BLIPMODE" BM)
   
10.    (setvar "orthomode" orth)
    
11.    (princ)
    
12. )
    
13. (defun c:water
    
14.    (/ SP EP HT OM CE BM DX AN NX NU AX PX
    
15.          P1 P2 P3 P4 P5 XSP XEP XT tmpep tmpsp ST EN)
    
16.    (if (not (tblsearch "LAYER" "water"))
    
17.    (command "layer" "m" "water" "c" "1" "" ""))
    
18.    (command "layer" "s" "water" "")
    
19.    (setvar "ucsfollow" 0)
    
20.    (setq OM (getvar "OSMODE"))
    
21.    (setq CE (getvar "CMDECHO"))
    
22.    (setq BM (getvar "BLIPMODE"))
    
23.    (setq orth (getvar "orthomode"))
    
24.    (setvar "CMDECHO" 0)
    
25.    (setvar "BLIPMODE" 0)
    
26.    (setvar "orthomode" 1)
    
27.    (setvar "OSMODE" 1)
    
28. (while    ; 加入循环
    
29.    (setq SP (getpoint "\nPick start point of water: "))
    
30.    (setvar "OSMODE" 0)
    
31.    (setq EP (getpoint SP "\nPick end point of water: "))
    
32.     (setq ST SP)
    
33.     (setq EN (polar SP (ANGLE SP EP) (DISTANCE SP EP)))
    
34.    (setq XSP (car SP) XEP (car EP))
    
35.    (if (> XSP XEP)
    
36.        (progn
    
37.        (setq tmpsp SP)
    
38.        (setq tmpep (list(car EP) (cadr SP)))
    
39.        (setq SP tmpep)
    
40.        (setq EP tmpsp)
    
41.        )
    
42.       )
    
43.      (setq DX (distance SP EP)
    
44.       AN (angle SP EP)
    
45.       NU (/ DX 100)
    
46.       AX (+ AN (/ pi 2))
    
47.       P1 (list (+ 20 (car SP)) (- (cadr SP) 20))
    
48.       P2 (list (+ 40 (car SP)) (- (cadr SP) 30))
    
49.       P3 (list (+ 60 (car SP)) (- (cadr SP) 30))
    
50.       P4 (list (+ 80 (car SP)) (- (cadr SP) 20))
    
51.       P5 (polar SP 0 100)
    
52.       ss (ssadd)                                ;;2011.6.27
    
53.       )
    
54.       (repeat (fix NU)
    
55.       (command ".PLINE" SP P1 P2 P3 P4 P5 "")
    
56.       (setq ss (ssadd (entlast) ss)) ;;2011.6
    
57.       (setq SP P5
    
58.       P1 (list (+ 20 (car SP)) (- (cadr SP) 20))
    
59.       P2 (list (+ 40 (car SP)) (- (cadr SP) 30))
    
60.       P3 (list (+ 60 (car SP)) (- (cadr SP) 30))
    
61.       P4 (list (+ 80 (car SP)) (- (cadr SP) 20))
    
62.       P5 (polar SP 0 100)      
    
63.       )
    
64.    )
    
65.    (setq ss (ssadd (entlast) ss))               ;;2011.6.27
    
66.    (command ".pedit" "m" ss "" "J" 0 "" )
    
67.    )           ;ebd while 结束循环
    
68.    (setvar "OSMODE" OM)
    
69.    (setvar "CMDECHO" CE)
    
70.    (setvar "BLIPMODE" BM)
    
71.    (setvar "orthomode" orth)
    
72.    (princ)
    
73. );end
    

;;学习 ssadd函数 2011.6<br /> (defun newerr (NE)<br />    (if (/= NE "Function cancelled")<br />       (princ (strcat "\nError: " NE))<br />    )<br />    (setvar "OSMODE" OM)<br />    (setvar "CMDECHO" CE)<br />    (setvar "BLIPMODE" BM)<br />    (setvar "orthomode" orth)<br />    (princ)<br /> )<br /> (defun c:water<br />    (/ SP EP HT OM CE BM DX AN NX NU AX PX<br />          P1 P2 P3 P4 P5 XSP XEP XT tmpep tmpsp ST EN)<br />    (if (not (tblsearch "LAYER" "water"))<br />    (command "layer" "m" "water" "c" "1" "" ""))<br />    (command "layer" "s" "water" "")<br />    (setvar "ucsfollow" 0)<br />    (setq OM (getvar "OSMODE")) <br />    (setq CE (getvar "CMDECHO")) <br />    (setq BM (getvar "BLIPMODE")) <br />    (setq orth (getvar "orthomode"))<br />    (setvar "CMDECHO" 0)<br />    (setvar "BLIPMODE" 0)<br />    (setvar "orthomode" 1)<br />    (setvar "OSMODE" 1)<br /> (while    ; 加入循环<br />    (setq SP (getpoint "\nPick start point of water: ")) <br />    (setvar "OSMODE" 0)<br />    (setq EP (getpoint SP "\nPick end point of water: "))<br />     (setq ST SP)<br />     (setq EN (polar SP (ANGLE SP EP) (DISTANCE SP EP)))<br />    (setq XSP (car SP) XEP (car EP))<br />    (if (> XSP XEP)<br />        (progn<br />        (setq tmpsp SP)<br />        (setq tmpep (list(car EP) (cadr SP)))<br />        (setq SP tmpep)<br />        (setq EP tmpsp)<br />        )<br />       ) <br />      (setq DX (distance SP EP)<br />       AN (angle SP EP)<br />       NU (/ DX 100)<br />       AX (+ AN (/ pi 2))<br />       P1 (list (+ 20 (car SP)) (- (cadr SP) 20))<br />       P2 (list (+ 40 (car SP)) (- (cadr SP) 30))<br />       P3 (list (+ 60 (car SP)) (- (cadr SP) 30))<br />       P4 (list (+ 80 (car SP)) (- (cadr SP) 20))<br />       P5 (polar SP 0 100)<br />       ss (ssadd)                                ;;2011.6.27<br />       )<br />       (repeat (fix NU)<br />       (command ".PLINE" SP P1 P2 P3 P4 P5 "")<br />       (setq ss (ssadd (entlast) ss)) ;;2011.6<br />       (setq SP P5<br />       P1 (list (+ 20 (car SP)) (- (cadr SP) 20))<br />       P2 (list (+ 40 (car SP)) (- (cadr SP) 30))<br />       P3 (list (+ 60 (car SP)) (- (cadr SP) 30))<br />       P4 (list (+ 80 (car SP)) (- (cadr SP) 20))<br />       P5 (polar SP 0 100)      <br />       )<br />    )<br />    (setq ss (ssadd (entlast) ss))               ;;2011.6.27<br />    (command ".pedit" "m" ss "" "J" 0 "" )<br />    )           ;ebd while 结束循环<br />    (setvar "OSMODE" OM)<br />    (setvar "CMDECHO" CE)<br />    (setvar "BLIPMODE" BM)<br />    (setvar "orthomode" orth)<br />    (princ)<br /> );end<br />

飞雪神光

英文提示 错误的代码根本不能运行 无意义的代码段  有AI的风格

meja

飞雪神光 发表于 2023-6-30 21:03
英文提示 错误的代码根本不能运行 无意义的代码段  有AI的风格

我把我写的无法运行的UCS代码删除了，你再看看。这个代码一定可以运行的！！！

飞雪神光

1. (defun c:water (/ *error* an cenpt dx ep lm-arcwith3p nu olducs sp ss)
   
2.   (defun *error*()
   
3.     (command "ucs" olducs "")
   
4.   )
   
5.   (if (not (tblsearch "layer" "water"))
   
6.     (entmake(list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")(cons 2 "water")'(62 . 1)'(70 . 0)'(6 . "CONTINUOUS")))
   
7.   )
   
8.   (defun lm-arcwith3p (center point1 point2 / rad1 rad2 r)
   
9.     (setq rad1 (angle center point1))
   
10.     (setq rad2 (angle center point2))
    
11.     (setq r (distance center point1))
    
12.     (entmake (list '(0 . "ARC")
    
13.                '(100 . "AcDbEntity")
    
14.                '(67 . 0)
    
15.                '(100 . "AcDbCircle")
    
16.                '(8 . "water")
    
17.                (cons 10 center)
    
18.                (cons 40 r)
    
19.                '(100 . "AcDbArc")
    
20.                (cons 50 rad1)
    
21.                (cons 51 rad2)
    
22.              )
    
23.     )
    
24.     (entlast)
    
25.   )
    
26.   (setq olducs (getvar "UCSORG"))
    
27.   (command "ucs" "w")
    
28.   (setvar "peditaccept" 1)
    
29.   (setvar "cmdecho" 0)
    
30.   (while (setq sp (getpoint "\n指定波浪线起点:"))
    
31.     (setq
    
32.       ep (getpoint sp "\n指定波浪线终点:")
    
33.       nu (/ (fix(distance sp ep)) 100)
    
34.       ss (ssadd)
    
35.     )
    
36.     (setq xsp (car sp) xep (car ep))
    
37.     (if (> xsp xep)
    
38.       (progn
    
39.         (setq tmpsp sp)
    
40.         (setq sp ep)
    
41.         (setq ep tmpsp)
    
42.         
    
43.       )
    
44.     )
    
45.     (setq an (angle sp ep))
    
46.     (repeat nu
    
47.       (setq cenpt(polar (polar sp an 50) (+ an (* pi 0.5)) 25))
    
48.       (setq ss (ssadd (lm-arcwith3p cenpt sp (setq ep(polar sp an 100))) ss))
    
49.       (setq sp ep)
    
50.     )
    
51.     (command ".pedit" "m" ss "" "J" 0 "" )
    
52.   )
    
53.   (command "ucs" olducs "")
    
54.   (princ)
    
55. )

(defun c:water (/ *error* an cenpt dx ep lm-arcwith3p nu olducs sp ss)<br />   (defun *error*()<br />     (command "ucs" olducs "")<br />   )<br />   (if (not (tblsearch "layer" "water"))<br />     (entmake(list'(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")(cons 2 "water")'(62 . 1)'(70 . 0)'(6 . "CONTINUOUS")))<br />   )<br />   (defun lm-arcwith3p (center point1 point2 / rad1 rad2 r)<br />     (setq rad1 (angle center point1))<br />     (setq rad2 (angle center point2))<br />     (setq r (distance center point1))<br />     (entmake (list '(0 . "ARC")<br />                '(100 . "AcDbEntity")<br />                '(67 . 0)<br />                '(100 . "AcDbCircle")<br />                '(8 . "water")<br />                (cons 10 center)<br />                (cons 40 r)<br />                '(100 . "AcDbArc")<br />                (cons 50 rad1)<br />                (cons 51 rad2)<br />              )<br />     )<br />     (entlast)<br />   )<br />   (setq olducs (getvar "UCSORG"))<br />   (command "ucs" "w")<br />   (setvar "peditaccept" 1)<br />   (setvar "cmdecho" 0)<br />   (while (setq sp (getpoint "\n指定波浪线起点:")) <br />     (setq <br />       ep (getpoint sp "\n指定波浪线终点:")<br />       nu (/ (fix(distance sp ep)) 100)<br />       ss (ssadd)<br />     )<br />     (setq xsp (car sp) xep (car ep))<br />     (if (> xsp xep)<br />       (progn<br />         (setq tmpsp sp)<br />         (setq sp ep)<br />         (setq ep tmpsp)<br />         <br />       )<br />     ) <br />     (setq an (angle sp ep))<br />     (repeat nu<br />       (setq cenpt(polar (polar sp an 50) (+ an (* pi 0.5)) 25))<br />       (setq ss (ssadd (lm-arcwith3p cenpt sp (setq ep(polar sp an 100))) ss))<br />       (setq sp ep)<br />     )<br />     (command ".pedit" "m" ss "" "J" 0 "" )<br />   )<br />   (command "ucs" olducs "")<br />   (princ)<br /> )

meja

飞雪神光 发表于 2023-6-30 21:38

感谢你的指点，仍然存在两个问题
第一，我的原设想是用三段线取代圆弧，不然开始就可以使用圆弧代替
第二，如果连续画线，第二次的起点应该为上次的终点

飞雪神光

那你自己改一改就好了

meja

飞雪神光 发表于 2023-6-30 23:58
那你自己改一改就好了

第一条我可以试试，但是第二条我还真不知道怎么进入循环

飞雪神光

meja 发表于 2023-7-1 00:28
第一条我可以试试，但是第二条我还真不知道怎么进入循环

1. (setq sp (getpoint "\n指定波浪线起点:"))
   
2. (setq ep (getpoint sp "\n指定波浪线终点:"))       
   
3. (while ep
   
4.        
   
5.        
   
6.         (setq ep (getpoint sp "\n指定波浪线终点:"))       
   
7. )

(setq sp (getpoint "\n指定波浪线起点:"))<br /> (setq ep (getpoint sp "\n指定波浪线终点:"))        <br /> (while ep<br />         <br />         <br />         (setq ep (getpoint sp "\n指定波浪线终点:"))        <br /> )

meja

飞雪神光 发表于 2023-7-1 10:35

2. (setq sp (getpoint "\n指定波浪线起点:"))     
   
3. (while ep        
   
4.         (setq ep (getpoint sp "\n指定波浪线终点:"))        
   
5. )

(setq sp (getpoint "\n指定波浪线起点:"))     <br /> (while ep        <br />         (setq ep (getpoint sp "\n指定波浪线终点:"))        <br /> )