line命令时每次只画一条线

Jacky_Yim

请问如何在用line命令时每次只画一条线，而不是连续画多条线！

1993063

2. (defun c:linex (/ p1 p2 dist ang ents pts linefuzz angfuzz)
   
3.   (setq linefuzz 4.0)
   
4.   (setq angfuzz 0.001)
   
5.   (defun makepline (spc pts / norm elv pline)
   
6.     (setq norm (trans '(0 0 1) 1 0 t)
   
7.           elv  (caddr (trans (car pts) 1 norm))
   
8.     )
   
9.     (setq pline
   
10.            (vlax-invoke
    
11.              spc
    
12.              'addlightweightpolyline
    
13.              (apply 'append
    
14.                     (mapcar '(lambda (pt)
    
15.                                (setq pt (trans pt 1 norm))
    
16.                                (list (car pt) (cadr pt))
    
17.                              )
    
18.                             pts
    
19.                     )
    
20.              )
    
21.            )
    
22.     )
    
23.     (vla-put-elevation pline elv)
    
24.     (vla-put-normal pline (vlax-3d-point norm))
    
25.     pline
    
26.   )
    
27.   (setq 45deg (/ pi 4))
    
28.   (setq p1 (getpoint "\n指定第一点: "))
    
29.   (while (and p1
    
30.               (setq p2 (getpoint p1 "\n下一点:"))
    
31.          )
    
32.     (setq dist (distance p1 p2)
    
33.           ang  (angle p1 p2)
    
34.     )
    
35.     (setq dist (* (fix (+ (/ dist linefuzz) 0.99)) linefuzz))
    
36.     (if        (< (rem ang 45deg) 0.0523599)
    
37.       (setq ang (* 45deg (fix (/ ang 45deg))))
    
38.       (princ (strcat "\nWarning: Segment "
    
39.                      (itoa (max (length pts) 1))
    
40.                      " is a non standard angle."
    
41.              )
    
42.       )
    
43.     )
    
44.     (setq p2 (polar p1 ang dist))
    
45.     (setq ents (cons
    
46.                  (entmakex
    
47.                    (list (cons 0 "LINE")
    
48.                          (cons 6 "BYLAYER")
    
49.                          (cons 10 p1)
    
50.                          (cons 11 p2)
    
51.                          (cons 39 0.0)
    
52.                          (cons 62 256)
    
53.                    )
    
54.                  )
    
55.                  ents
    
56.                )
    
57.           pts  (if pts
    
58.                  (cons p2 pts)
    
59.                  (list p2 p1)
    
60.                )
    
61.     )
    
62.     (setq p1 p2)
    
63.   )
    
64.   (and pts
    
65.        (null (initget "Yes No"))
    
66.        (/= (getkword "\n转换为多段线[(Y)es/(N)o] <Yes>: ")
    
67.            "No"
    
68.        )
    
69.        (makepline
    
70.          (if (= 1 (getvar "CVPORT"))
    
71.            (vla-get-paperspace
    
72.              (vla-get-activedocument (vlax-get-acad-object))
    
73.            )
    
74.            (vla-get-modelspace
    
75.              (vla-get-activedocument (vlax-get-acad-object))
    
76.            )
    
77.          )
    
78.          pts
    
79.        )
    
80.        (mapcar 'entdel ents)
    
81.   )
    
82.   (princ)
    
83. )

(defun c:linex (/ p1 p2 dist ang ents pts linefuzz angfuzz)<br />   (setq linefuzz 4.0)<br />   (setq angfuzz 0.001)<br />   (defun makepline (spc pts / norm elv pline)<br />     (setq norm (trans '(0 0 1) 1 0 t)<br />           elv  (caddr (trans (car pts) 1 norm))<br />     )<br />     (setq pline<br />            (vlax-invoke<br />              spc<br />              'addlightweightpolyline<br />              (apply 'append<br />                     (mapcar '(lambda (pt)<br />                                (setq pt (trans pt 1 norm))<br />                                (list (car pt) (cadr pt))<br />                              )<br />                             pts<br />                     )<br />              )<br />            )<br />     )<br />     (vla-put-elevation pline elv)<br />     (vla-put-normal pline (vlax-3d-point norm))<br />     pline<br />   )<br />   (setq 45deg (/ pi 4))<br />   (setq p1 (getpoint "\n指定第一点: "))<br />   (while (and p1<br />               (setq p2 (getpoint p1 "\n下一点:"))<br />          )<br />     (setq dist (distance p1 p2)<br />           ang  (angle p1 p2)<br />     )<br />     (setq dist (* (fix (+ (/ dist linefuzz) 0.99)) linefuzz))<br />     (if        (< (rem ang 45deg) 0.0523599)<br />       (setq ang (* 45deg (fix (/ ang 45deg))))<br />       (princ (strcat "\nWarning: Segment "<br />                      (itoa (max (length pts) 1))<br />                      " is a non standard angle."<br />              )<br />       )<br />     )<br />     (setq p2 (polar p1 ang dist))<br />     (setq ents (cons<br />                  (entmakex<br />                    (list (cons 0 "LINE")<br />                          (cons 6 "BYLAYER")<br />                          (cons 10 p1)<br />                          (cons 11 p2)<br />                          (cons 39 0.0)<br />                          (cons 62 256)<br />                    )<br />                  )<br />                  ents<br />                )<br />           pts  (if pts<br />                  (cons p2 pts)<br />                  (list p2 p1)<br />                )<br />     )<br />     (setq p1 p2)<br />   )<br />   (and pts<br />        (null (initget "Yes No"))<br />        (/= (getkword "\n转换为多段线[(Y)es/(N)o] <Yes>: ")<br />            "No"<br />        )<br />        (makepline<br />          (if (= 1 (getvar "CVPORT"))<br />            (vla-get-paperspace<br />              (vla-get-activedocument (vlax-get-acad-object))<br />            )<br />            (vla-get-modelspace<br />              (vla-get-activedocument (vlax-get-acad-object))<br />            )<br />          )<br />          pts<br />        )<br />        (mapcar 'entdel ents)<br />   )<br />   (princ)<br /> )

Jacky_Yim

这个程序是干什么用？

xhq1954425

画完一条线就回车结束，不要再继续点击左键了……或你把你的问题说清楚点？比方说你感到有何不便……

dunkel

怀疑你的 LINE 命令被重新定义了，或许是中了 lsp 病毒造成的；试试 .line 命令，就在 line 前加个小数点，这个应该是正常的