画"云线"增强版本

wudechao

(defun c:ly (/ yesno r1 r2 tst pt1 pt2 test tmp n new-rr en-data)
(setvar "cmdecho" 0)
(initget "R P C E")
(setq yesno (getkword "\n云线轮廓[矩形(R)/多边形(P)/圆形(C)/椭圆形(E)] <R>:"))
(cond
  ((= yesno "R")
   (setq tst 1)
  )
  ((= yesno "r")
   (setq tst 1)
  )
  ((= yesno "P")
   (setq tst 2)
  )
  ((= yesno "p")
   (setq tst 2)
  )
  ((= yesno "C")
   (setq tst 3)
  )
  ((= yesno "c")
   (setq tst 3)
  )
  ((= yesno "E")
   (setq tst 4)
  )
  ((= yesno "e")
   (setq tst 4)
  )
  (t
   (setq tst 1)
  )
)
(while (= "A" (progn
  (initget "A")
  (setq pt1 (getpoint "\n[修改弧长(A)/指定起点]<退出>:"))
        )
)
  (command "_revcloud")
  (command)
  (initget 6)
  (setq r1 (getint "\n指定最小弧长<默认>:")
r2 (getint "\n指定最大弧长<默认>:")
  )
  (if (= r1 nil)
   (setq r1 500)
  )
  (if (= r2 nil)
   (setq r2 800)
  )
)
(command "_revcloud" "S" "C" "A" r1 r2)
(command)
(setq n 0
       pt2 t
)
(while (and
  (= tst 1)
  pt2
)
  (progn
   (if (> n 0)
    (setq pt1 (getpoint "\n指定第一个角点<退出>:"))
   )
   (setq pt2 (getcorner pt1 "\n指定另一个角点："))
   (if (= pt2 "")
    (setq pt2 nil)
   )
   (command "_rectang" pt1 pt2)
   (command "_revcloud" "O" "" (entlast) "N")
   (setq n (+ n 1))
  )
)
(while (and
  (= tst 2)
  pt2
)
  (setq test t)
  (while test
   (progn
    (if (> n 0)
     (setq pt1 (getpoint "\n指定起始点<退出>: "))
    )
    (if (setq pt2 (getpoint pt1 "\n指定下一点: "))
     (progn
      (if (= pt2 "")
       (setq pt2 nil)
      )
      (command "_.pline" "non" pt1 "non" pt2)
      (while test
       (setq tmp (grread t 7 0))
       (redraw)
       (cond
((= (car tmp) 3)
  (setq pt2 (cadr tmp))
  (command "non" pt2)
)
((= (car tmp) 11)
  (command "c")
  (command "_revcloud" "O" "" (entlast) "N")
  (setq test nil)
)
((= (car tmp) 5)
  (setq pt (cadr tmp))
  (grdraw pt pt1 1 1)
  (grdraw pt pt2 2)
)
       )
      )
     )
    )
    (setq n (+ n 1))
   )
  )
)
(while (and
  (= tst 3)
  pt2
)
  (progn
   (if (> n 0)
    (setq pt1 (getpoint "\n指定圆的圆心<退出>:"))
   )
   (command "_.CIRCLE" pt1 1)
   (setq en-data (entget (entlast)))
   (setq test t)
   (while test
    (setq tmp (grread t 7 0))
    (redraw)
    (cond
     ((= (car tmp) 3)
      (setq pt2 (cadr tmp))
      (command "_revcloud" "O" "" (entlast) "N")
      (redraw)
      (setq test nil)
     )
     ((= (car tmp) 11)
      (entdel (entlast))
      (setq test nil)
     )
     ((= (car tmp) 5)
      (setq pt (cadr tmp))
      (grdraw pt pt1 7)
      (setq new-rr (distance pt1 pt))
      (setq en-data (subst
       (cons 40 new-rr)
       (assoc 40 en-data)
       en-data
      )
      )
      (entmod en-data)
     )
    )
   )
   (setq n (+ n 1))
  )
)
(while (and
  (= tst 4)
  pt2
)
  (progn
   (if (> n 0)
    (setq pt1 (getpoint "\n指定椭圆的轴端点<退出>:"))
   )
   (setq pt2 (getpoint pt1 "\n指定轴的另一个端点:"))
   (if (= pt2 "")
    (setq pt2 nil)
   )
   (command "_.ellipse" pt1 pt2 pause)
   (command "_revcloud" "O" "" (entlast) "N")
   (setq n (+ n 1))
  )
)
(setvar "cmdecho" 1)
(princ)
)

tensir

感谢作者的分享！

yjr111

试了一下，多边形的一用电脑就接近死机，也没见云线画出来，其他OK很方便！

CTC

我04的全提示都有问题。望楼主看下。

smartstar

把                      ((= (car tmp) 11)                 (command "c")
                 (command "_revcloud" "O" "" (entlast) "N")
                 (setq test nil)
                )


改成                     ((= (car tmp) 25)                 (command "c")
                 (command "_revcloud" "O" "" (entlast) "N")
                 (setq test nil)
                )
就ok了

nt8011

很好的程序！不过有两个问题：1、cad2004中出错。2、cad2008中，命令结束时出现“cad2004中”。

vlisp2012

;;;在cad2011下，全部功能可用
(defun c:ly (/ yesno r1 r2 tst pt1 pt2 test tmp n new-rr en-data)
(setvar "cmdecho" 0)
(initget "R P C E")
(setq yesno (getkword "\n云线轮廓[矩形(R)/多边形(P)/圆形(C)/椭圆形(E)] <R>:"))
(cond
  ((= yesno "R")
   (setq tst 1)
  )
  ((= yesno "r")
   (setq tst 1)
  )
  ((= yesno "P")
   (setq tst 2)
  )
  ((= yesno "p")
   (setq tst 2)
  )
  ((= yesno "C")
   (setq tst 3)
  )
  ((= yesno "c")
   (setq tst 3)
  )
  ((= yesno "E")
   (setq tst 4)
  )
  ((= yesno "e")
   (setq tst 4)
  )
  (t
   (setq tst 1)
  )
)
(while (= "A" (progn
  (initget "A")
  (setq pt1 (getpoint "\n[修改弧长(A)/指定起点]<退出>:"))
        )
)
  (command "_revcloud")
  (command)
  (initget 6)
  (setq r1 (getint "\n指定最小弧长<默认>:")
r2 (getint "\n指定最大弧长<默认>:")
  )
  (if (= r1 nil)
   (setq r1 500)
  )
  (if (= r2 nil)
   (setq r2 800)
  )
)
(command "_revcloud" "S" "C" "A" r1 r2)
(command)
(setq n 0
       pt2 t
)
(while (and
  (= tst 1)
  pt2
)
  (progn
   (if (> n 0)
    (setq pt1 (getpoint "\n指定第一个角点<退出>:"))
   )
   (setq pt2 (getcorner pt1 "\n指定另一个角点："))
   (if (= pt2 "")
    (setq pt2 nil)
   )
   (command "_rectang" pt1 pt2)
   (command "_revcloud" "O" "" (entlast) "N")
   (setq n (+ n 1))
  )
)
(while (and
  (= tst 2)
  pt2
)
  (setq test t)
  (while test
   (progn
    (if (> n 0)
     (setq pt1 (getpoint "\n指定起始点<退出>: "))
    )
    (if (setq pt2 (getpoint pt1 "\n指定下一点: "))
     (progn
      (if (= pt2 "")
       (setq pt2 nil)
      )
      (command "_.pline" "non" pt1 "non" pt2)
      (while test
       (setq tmp (grread t 7 0))
       (redraw)
       (cond
((= (car tmp) 3)
  (setq pt2 (cadr tmp))
  (command "non" pt2)
)
((= (car tmp) 25)
  (command "c")
  (command "_revcloud" "O" "" (entlast) "N")
  (setq test nil)
)
((= (car tmp) 5)
  (setq pt (cadr tmp))
  (grdraw pt pt1 1 1)
  (grdraw pt pt2 2)
)
       )
      )
     )
    )
    (setq n (+ n 1))
   )
  )
)
(while (and
  (= tst 3)
  pt2
)
  (progn
   (if (> n 0)
    (setq pt1 (getpoint "\n指定圆的圆心<退出>:"))
   )
   (command "_.CIRCLE" pt1 1)
   (setq en-data (entget (entlast)))
   (setq test t)
   (while test
    (setq tmp (grread t 7 0))
    (redraw)
    (cond
     ((= (car tmp) 3)
      (setq pt2 (cadr tmp))
      (command "_revcloud" "O" "" (entlast) "N")
      (redraw)
      (setq test nil)
     )
     ((= (car tmp) 11)
      (entdel (entlast))
      (setq test nil)
     )
     ((= (car tmp) 5)
      (setq pt (cadr tmp))
      (grdraw pt pt1 7)
      (setq new-rr (distance pt1 pt))
      (setq en-data (subst
       (cons 40 new-rr)
       (assoc 40 en-data)
       en-data
      )
      )
      (entmod en-data)
     )
    )
   )
   (setq n (+ n 1))
  )
)
(while (and
  (= tst 4)
  pt2
)
  (progn
   (if (> n 0)
    (setq pt1 (getpoint "\n指定椭圆的轴端点<退出>:"))
   )
   (setq pt2 (getpoint pt1 "\n指定轴的另一个端点:"))
   (if (= pt2 "")
    (setq pt2 nil)
   )
   (command "_.ellipse" pt1 pt2 pause)
   (command "_revcloud" "O" "" (entlast) "N")
   (setq n (+ n 1))
  )
)
(setvar "cmdecho" 1)
(princ)
)

CTC

vlisp2012 发表于 2012-4-23 19:41
;;;在cad2011下，全部功能可用
(defun c:ly (/ yesno r1 r2 tst pt1 pt2 test tmp n new-rr en-data)
(se ...

请测试下2004是否全部可用 。

adc

多边形不能画闭合

SHOUXI

2004版能用！

xotoo

如何取消手绘样式改为普通样式啊