画"云线"增强版本

guankuiwu · 发表于 2012-5-9 15:25:39

多边形不成哦!!

wudechao · 发表于 2012-5-9 22:09:25

本帖最后由 wudechao 于 2012-5-9 22:09 编辑

终于找到多边形不行的原因:最小弧长和最大弧长采用CAD默认的0.5肯定不行.用这个命令前必须先改弧长.比如改为500

QWQWQWQ · 发表于 2012-9-1 21:36:23

2007环境全能用

ejingsong · 发表于 2013-8-7 00:25:35

(defun c:ly (/ )
;;; ;_定义错误
;;; (defun #err99 (s)
;;; (command ".UNDO" "E")
;;; (setvar "CECOLOR" c)
;;; (setvar "OSMODE" snap)
;;; (setq *error* $orr)
;;; )
;;; (setq $orr *error*)
;;; (setq *error* #err99)
;;; (setvar "CMDECHO" 0)
;;; (command ".UNDO" "BE")
;;; (setvar "OSMODE" 0)
;;; (setq c (getvar "CECOLOR")
;;;snap (getvar "OSMODE")
;;; )
;;; (setq *error* #err99)
(Setq osmode_bak (getvar "osmode"));_记录捕捉
(Setq clayer_bak (getvar "clayer"));_记录当前图层
(Setvar "cmdecho" 0);_关闭命令提示
(Setvar "osmode" 0);_关闭捕捉
(if (= (tblsearch "layer" "yunxian") nil)
(progn
(command "layer" "m" "yunxian" "c" "1" "" "")
)
);_建立图层
(SETVAR "CLAYER" "yunxian");设为当前图层
(setq yesno (getkword "\n云线轮廓[矩形(R)/圆形(C)] <R>:"))
(cond
((= yesno "R")
(setq tst 1)
)
((= yesno "r")
(setq tst 1)
)
((= yesno "C")
(setq tst 2)
)
((= yesno "c")
(setq tst 2)
)
(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
)
(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))
)
)
(Setvar "osmode" osmode_bak);_还原捕捉
(Setvar "clayer" clayer_bak);_还原当前图层
(Setvar "cmdecho" 1);_打开命令提示
(Princ);_关闭程序返回值
);_程序结束

(defun c:ly (/    ) 
;;;  ;_定义错误 
;;;   (defun #err99 (s) 
;;;    (command ".UNDO" "E") 
;;;    (setvar "CECOLOR" c) 
;;;    (setvar "OSMODE" snap) 
;;;    (setq *error* $orr) 
;;;  ) 
;;;  (setq $orr *error*) 
;;;  (setq *error* #err99) 
;;;  (setvar "CMDECHO" 0) 
;;;  (command ".UNDO" "BE") 
;;;  (setvar "OSMODE" 0) 
;;;  (setq c (getvar "CECOLOR") 
;;;snap (getvar "OSMODE") 
;;;  ) 
;;;  (setq *error* #err99) 
(Setq osmode_bak (getvar "osmode"));_记录捕捉 
(Setq clayer_bak (getvar "clayer"));_记录当前图层 
(Setvar "cmdecho" 0);_关闭命令提示 
(Setvar "osmode" 0);_关闭捕捉 
(if (= (tblsearch "layer" "yunxian") nil) 
    (progn 
      (command "layer" "m" "yunxian" "c" "1" "" "") 
    ) 
  );_建立图层 
(SETVAR "CLAYER" "yunxian");设为当前图层   
(setq yesno (getkword "\n云线轮廓[矩形(R)/圆形(C)] <R>:")) 
(cond 
  ((= yesno "R") 
   (setq tst 1) 
  ) 
  ((= yesno "r") 
   (setq tst 1) 
  ) 
  ((= yesno "C") 
   (setq tst 2) 
  ) 
  ((= yesno "c") 
   (setq tst 2) 
  ) 
  (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 
) 
  (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)) 
  ) 
 ) 
(Setvar "osmode" osmode_bak);_还原捕捉 
(Setvar "clayer" clayer_bak);_还原当前图层 
(Setvar "cmdecho" 1);_打开命令提示 
(Princ);_关闭程序返回值 
);_程序结束

楼主您好我的意思是想新建一个图层并设定为当前层画完云线退出并记忆捕捉画完恢复不太会lsp 照猫画虎加了些东西可是一直得不到想要的结果您有时间可以看看吗

szx025 · 发表于 2013-8-7 08:32:03

程序不错，但如果我想让画的云线是细线，有高手能改一下程序吗

clinber · 发表于 2013-8-8 23:53:04

其实我觉得还是一个比较实在反正都是标记越简单越好避免选择浪费的时间

l18c19 · 发表于 2013-8-14 14:16:55

加载后输入LY怎么没反应？

lengyan · 发表于 2014-12-10 21:21:24

试了一下，很给力

mjz521yy · 发表于 2014-12-11 15:53:32

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

lizhiqiang9801 · 发表于 2015-8-31 09:04:44

多边形不成功我用的是CAD2007

账号		自动登录	找回密码
密码			注册