2002版画云线LISP

mtldsw

我想封闭末点和起点，不能封闭。请高手帮忙看看程序错在哪儿？

(defun c:yx()

(setvar "cmdecho" 0)
 (setq d1 0)

(setq pt (getpoint "\n起点:"))
 (setq pttt pt)
(while pt
(setq pt1 (getpoint pt "\n下一点:"))

 

 
(if ( = d1 0)
  (setq d1 (distance pt pt1))
)

 (if(= pt1 pttt)                           
  (setq d1 (distance pt pt1))
  )

 
  (setq d2 (/ d1 (sqrt 3)))
  (setq ang1 (angle pt pt1))
  (setq ang (+ ang1 (/ pi 6)))
 
 
  (setq pty (polar pt ang d2))
 
  (setq ptx (polar pt ang1 d1))
 
 
(command "arc" pt pty ptx   "")
(setvar "osmode" 695)
  (setq pt ptx)
 
)
 
  (setvar "cmdecho" 1)

(prin1)
)
 

ZZXXQQ

(defun c:yx()
 (setvar "cmdecho" 0)
 (setq d1 0)
 (setq pt (getpoint "\n起点:"))
 (setq pttt pt)
 (while pt
  (setq pt1 (getpoint pt "\n下一点:"))
  (if (= d1 0) (setq d1 (distance pt pt1)))
  (if (equal (diatance pt1 pttt) 0.0 0.001) (setq d1 (distance pt pt1)))
  (setq d2 (/ d1 (sqrt 3)))
  (setq ang1 (angle pt pt1))
  (setq ang (+ ang1 (/ pi 6)))
  (setq pty (polar pt ang d2))
  (setq ptx (polar pt ang1 d1))
  (command "arc" pt pty ptx)
  (setvar "osmode" 695)
  (setq pt ptx)
  (if (equal (diatance pt1 pttt) 0.0 0.001) (setq pt nil))
 )
 (setvar "cmdecho" 1)
 (prin1)
)

mtldsw

发现老大的也不能用，发现  diatance 应为  distance  ，谢谢老大

mtldsw

另外再提个问题，能不能把画的云线变成一个块，这样删除的时候方便。

ZZXXQQ

变成复线行吗？

mtldsw

只要是一个块，删除方便就行。谢谢。复线也不会占多大空间的。

Gu_xl

;;;连成多段线

3. (defun c:yx()
4. (setvar "cmdecho" 0)
5.   (setq en (entlast))
6. (setq d1 0)
7. (setq pt (getpoint "\n起点:"))
8. (setq pttt pt)
9. (while pt
10.   (setq pt1 (getpoint pt "\n下一点:"))
11.   (if (= d1 0) (setq d1 (distance pt pt1)))
12.   (if (equal (distance pt1 pttt) 0.0 0.001) (setq d1 (distance pt pt1)))
13.   (setq d2 (/ d1 (sqrt 3)))
14.   (setq ang1 (angle pt pt1))
15.   (setq ang (+ ang1 (/ pi 6)))
16.   (setq pty (polar pt ang d2))
17.   (setq ptx (polar pt ang1 d1))
18.   (command "arc" pt pty ptx)
19.   (setvar "osmode" 695)
20.   (setq pt ptx)
21.   (if (equal (distance pt1 pttt) 0.0 0.001) (setq pt nil))
22. )
23.     (setq ss (ssadd))
24.   (while (setq ent1 (entnext en))
25.     (ssadd ent1 ss)
26.     (setq en ent1)
27.     )
28.   
29.   
30.   (if (>  (sslength ss) 0) (command "pedit" (entlast) "y" "j" ss "" ""))
31. (setvar "cmdecho" 1)
32. (prin1)
33. )

(defun c:yx() (setvar "cmdecho" 0)   (setq en (entlast)) (setq d1 0) (setq pt (getpoint "\n起点:")) (setq pttt pt) (while pt   (setq pt1 (getpoint pt "\n下一点:"))   (if (= d1 0) (setq d1 (distance pt pt1)))   (if (equal (distance pt1 pttt) 0.0 0.001) (setq d1 (distance pt pt1)))   (setq d2 (/ d1 (sqrt 3)))   (setq ang1 (angle pt pt1))   (setq ang (+ ang1 (/ pi 6)))   (setq pty (polar pt ang d2))   (setq ptx (polar pt ang1 d1))   (command "arc" pt pty ptx)   (setvar "osmode" 695)   (setq pt ptx)   (if (equal (distance pt1 pttt) 0.0 0.001) (setq pt nil)) )     (setq ss (ssadd))   (while (setq ent1 (entnext en))     (ssadd ent1 ss)     (setq en ent1)     )         (if (>  (sslength ss) 0) (command "pedit" (entlast) "y" "j" ss "" "")) (setvar "cmdecho" 1) (prin1) )

Gu_xl

;;;接近CAD自带云线功能，不带自动翻转功能

3. (defun c:yx()
4. (setvar "cmdecho" 0)
5.   (setq en (entlast))
6. (setq d1 0)
7.   
8.   (setq R (/ (getvar "viewsize") 10))
9.   (princ "默认弧长：R=")
10.   (princ R)
11.   (while (= "A" (progn
12.   (initget "A  ")
13. (setq pt (getpoint "\n[弧长<A>/起点:"))
14.   )
15.      )
16.     (initget 7)
17.     (setq R (getreal "输入弧长："))
18.     )
19. (setq pttt pt pd t)
20.   
21. (while pd
22.    (while (progn
23.                   (setq gr (grread T 1))
24.     (if (= (car gr) 5)
25.       (progn
26.       (setq pt1 (cadr gr));setq
27.       (< (distance pt1 pt) R)
28.       );progn
29.       t
30.   
31.          );progn
32.   )
33.     )
34.    (if (< (distance pt1 pttt) R)
35.      (setq pt1 pttt
36.     pd nil)
37.      )
38.    (setq d1 (distance pt pt1))
39.   (setq d2 (/ d1 (sqrt 3)))
40.   (setq ang1 (angle pt pt1))
41.   (setq ang (+ ang1 (/ pi 6)))
42.   (setq pty (polar pt ang d2))
43.   (setq ptx (polar pt ang1 d1))
44.   (command "arc" pt pty ptx)
45.   (setvar "osmode" 695)
46.   (setq pt ptx)
47. )
48.     (setq ss (ssadd))
49.   (while (setq ent1 (entnext en))
50.     (ssadd ent1 ss)
51.     (setq en ent1)
52.     )
53.   
54.   
55.   (if (>  (sslength ss) 0) (command "pedit" (entlast) "y" "j" ss "" ""))
56. (setvar "cmdecho" 1)
57. (prin1)
58. )

(defun c:yx() (setvar "cmdecho" 0)   (setq en (entlast)) (setq d1 0)      (setq R (/ (getvar "viewsize") 10))   (princ "默认弧长：R=")   (princ R)   (while (= "A" (progn   (initget "A  ") (setq pt (getpoint "\n[弧长<A>/起点:"))   )      )     (initget 7)     (setq R (getreal "输入弧长："))     ) (setq pttt pt pd t)    (while pd    (while (progn                   (setq gr (grread T 1))     (if (= (car gr) 5)       (progn       (setq pt1 (cadr gr));setq       (< (distance pt1 pt) R)       );progn       t             );progn   )     )    (if (< (distance pt1 pttt) R)      (setq pt1 pttt     pd nil)      )    (setq d1 (distance pt pt1))   (setq d2 (/ d1 (sqrt 3)))   (setq ang1 (angle pt pt1))   (setq ang (+ ang1 (/ pi 6)))   (setq pty (polar pt ang d2))   (setq ptx (polar pt ang1 d1))   (command "arc" pt pty ptx)   (setvar "osmode" 695)   (setq pt ptx) )     (setq ss (ssadd))   (while (setq ent1 (entnext en))     (ssadd ent1 ss)     (setq en ent1)     )         (if (>  (sslength ss) 0) (command "pedit" (entlast) "y" "j" ss "" "")) (setvar "cmdecho" 1) (prin1) )

Gu_xl

再改了改，已接近CAD自带的云线功能，可自动判断圆弧方向，并自动翻转！

3. (defun c:yx(/ plist returnLwpoly en ss pd gr pt pt0 pt1 pttt d1 d2 ptx pty R ang ang1 ent1)
4. (defun gxl-clock (plist / k n count p0 p1 p2 x0 y0 x1 y1 x2 y2)
5.   
6.   (setq k (length plist)
7. n 0
8. count 0)
9.   (if (> k 2)
10.     (repeat (- k 2)
11.       (setq p0 (nth n plist)
12.      p1 (nth (1+ n) plist)
13.      p2 (nth (+ n 2) plist)
14.      )
15.       (setq x0 (car p0)
16.      y0 (cadr p0)
17.      x1 (car p1)
18.      y1 (cadr p1)
19.      x2 (car p2)
20.      y2 (cadr p2)
21.      )
22.       (setq rtn (- (* (- x1 x0) (- y2 y1)) (* (- y1 y0) (- x2 x1))))
23.       (if (> rtn 0) (setq count (1+ count))(setq count (1- count)))
24.       (setq n (1+ n))
25.       
26.       )
27.     )
28.   (if (> count 0) t nil)
29.   )
30.   (defun returnLwpoly (ent / New enl)
31.   (setq enl (entget ent))
32.   (foreach a enl
33.     (if (= 42 (car a))
34.       (progn
35. (setq new (append new (list (cons 42 (* -1 (cdr a))))))
36. )
37.       (setq new (append new (list a)))
38.       )
39.     )
40.   (entmod new)
41.   )
42. (setvar "cmdecho" 0)
43.   (setq oldosmode (getvar "osmode"))
44.   (setvar "osmode" 0)
45.    (setq en (entlast))
46. (setq d1 0)
47.   
48.   (setq R (/ (getvar "viewsize") 30))
49.   (princ "\n默认弧长：R=")
50.   (princ R)
51.   (while (= "A" (progn
52.   (initget "A  ")
53. (setq pt (getpoint "\n[弧长<A>/起点:"))
54.   
55.   )
56.      )
57.     (initget 7)
58.     (setq R (getreal "\n输入弧长："))
59.     )
60.    (setq plist (cons pt plist))
61. (setq pttt pt pd t pt0 pt)
62.   ;;;
63.    (command "pline" pttt "a")
64.    ;;;
65. (while pd
66.    (while (progn
67.                   (setq gr (grread T 1))
68.     (if (= (car gr) 5)
69.       (progn
70.       (setq pt1 (cadr gr));setq
71.       (< (distance pt1 pt) R)
72.       );progn
73.       t
74.   
75.          );progn
76.   )
77.     )
78. (setq pt1 (polar pt0 (angle pt0 pt1 r)))
79.    (if (< (distance pt1 pttt) r)
80.      (setq pt1 pttt
81.     pd nil)
82.      )
83. (setq pt0 pt1)
84.    (setq plist (cons pt1 plist))
85.    (setq d1 (distance pt pt1))
86.   (setq d2 (/ d1 (sqrt 3)))
87.   (setq ang1 (angle pt pt1))
88.   (setq ang (+ ang1 (/ pi 6)))
89.   (setq pty (polar pt ang d2))
90.   (setq ptx (polar pt ang1 d1))
91.   ;(command "arc" pt pty ptx)
92.    (command "s"  pty ptx)
93.   (setq pt ptx)
94. )
95.    (command "")
96.    
97.   (setq en (entlast))
98.   (setq plist (reverse plist))
99.    (if (gxl-clock plist) (returnLwpoly en))
100.     (setvar "cmdecho" 1)
101.   (setvar "osmode" oldosmode)
102. (prin1)
103. )

(defun c:yx(/ plist returnLwpoly en ss pd gr pt pt0 pt1 pttt d1 d2 ptx pty R ang ang1 ent1) (defun gxl-clock (plist / k n count p0 p1 p2 x0 y0 x1 y1 x2 y2)      (setq k (length plist) n 0 count 0)   (if (> k 2)     (repeat (- k 2)       (setq p0 (nth n plist)      p1 (nth (1+ n) plist)      p2 (nth (+ n 2) plist)      )       (setq x0 (car p0)      y0 (cadr p0)      x1 (car p1)      y1 (cadr p1)      x2 (car p2)      y2 (cadr p2)      )       (setq rtn (- (* (- x1 x0) (- y2 y1)) (* (- y1 y0) (- x2 x1))))       (if (> rtn 0) (setq count (1+ count))(setq count (1- count)))       (setq n (1+ n))              )     )   (if (> count 0) t nil)   )   (defun returnLwpoly (ent / New enl)   (setq enl (entget ent))   (foreach a enl     (if (= 42 (car a))       (progn (setq new (append new (list (cons 42 (* -1 (cdr a)))))) )       (setq new (append new (list a)))       )     )   (entmod new)   ) (setvar "cmdecho" 0)   (setq oldosmode (getvar "osmode"))   (setvar "osmode" 0)    (setq en (entlast)) (setq d1 0)      (setq R (/ (getvar "viewsize") 30))   (princ "\n默认弧长：R=")   (princ R)   (while (= "A" (progn   (initget "A  ") (setq pt (getpoint "\n[弧长<A>/起点:"))      )      )     (initget 7)     (setq R (getreal "\n输入弧长："))     )    (setq plist (cons pt plist)) (setq pttt pt pd t pt0 pt)   ;;;    (command "pline" pttt "a")    ;;; (while pd    (while (progn                   (setq gr (grread T 1))     (if (= (car gr) 5)       (progn       (setq pt1 (cadr gr));setq       (< (distance pt1 pt) R)       );progn       t             );progn   )     ) (setq pt1 (polar pt0 (angle pt0 pt1 r)))    (if (< (distance pt1 pttt) r)      (setq pt1 pttt     pd nil)      ) (setq pt0 pt1)    (setq plist (cons pt1 plist))    (setq d1 (distance pt pt1))   (setq d2 (/ d1 (sqrt 3)))   (setq ang1 (angle pt pt1))   (setq ang (+ ang1 (/ pi 6)))   (setq pty (polar pt ang d2))   (setq ptx (polar pt ang1 d1))   ;(command "arc" pt pty ptx)    (command "s"  pty ptx)   (setq pt ptx) )    (command "")       (setq en (entlast))   (setq plist (reverse plist))    (if (gxl-clock plist) (returnLwpoly en))     (setvar "cmdecho" 1)   (setvar "osmode" oldosmode) (prin1) )

mtldsw

哇，高手真多，很好用，谢谢~