52幕墙设计 发表于 2013-9-4 11:19:28

动态云线

本帖最后由 52幕墙设计 于 2020-5-10 15:55 编辑


;动态云线，初学者第一次，希望多多支持
(defun c:YUN( / aa cdu ent jdu kk l msg os p0 p1 pa pb ss sss temp *error*)
(defun *error*(msg)
   (setvar "cmdecho" temp)
   (setvar"cecolor" ocolo)
   (setvar "clayer" oldlay)
   (redraw)
   (if (> (setq os (getvar 'osmode)) 16383) (setvar 'osmode (- os 16384)))
   (princ msg)
   (exit)
   (princ)         
   )
(setq oldlay (getvar "clayer"))
(setq temp (getvar "cmdecho"))
(setq ocolo(getvar"cecolor"))
(if(null (tblsearch "layer" "yunxian"))
      (command "layer" "n" "yunxian" "c" "6" "yunxian" ""))
    (setvar "clayer" "yunxian")
(setvar"cecolor" "bylayer")
(if(and(setq pa(getpoint"\n矩形第一点"))(setq pb(getcorner pa"\n矩形第二点")))
(progn(command"RECTANG" pa pb)
(setq ss(entlast))(setq jdu(angle pa pb))(setq cdu(*(distance pa pb)0.99))(setq p0(polar pa jdu cdu)))
)
(setvar "cmdecho" 0)
(if(not(and pa pb))(progn
;(setq sss(entsel"选择对象"))
;(setq p0(osnap (cadr sss) "near"))(setq ss(car sss))))
(setq sss (ssget ":E:S" '((0 . "line,LWPOLYLINE,circle,ARC,spline,ELLIPSE,"))))
(setq ss(ssname sss 0))))
(setq ent(entget ss))
(setq aa nil)
(while(= 5(car(setq kk(grread T 1 0))))
   (setq p1(cadr kk))
   (if(= p0 nil)(setq p0(polar p1 pi 1)))
   (cond ((= aa t)(entdel ss)))
   (if(= aa t)(progn(entmake ent)(setq ss(entlast))))
   (redraw)
   (grdraw p0 p1 1)
   (setq l(distance p0 p1))(setq l(/ l 2))
   (if (< (setq os (getvar 'osmode)) 16384) (setvar 'osmode (+ os 16384)))
   (command"_revcloud" "A" l l "o"ss"n")
   (if (> (setq os (getvar 'osmode)) 16383) (setvar 'osmode (- os 16384)))
   (setq ss(entlast))
   (setq aa t)
)
(redraw)
(setvar"cecolor" ocolo)
(setvar "clayer" oldlay)
(setvar "cmdecho" temp)
(princ)
)

52幕墙设计 发表于 2020-5-10 15:56:06

yanchao316 发表于 2016-6-7 18:23
求救到底怎么做才能用啊，我复制代码在txt改成lsp出现：命令: 读入的 (八进制) 字符不正确: 0，直接转存代 ...

我上传了lsp文件，可以直接下载试试

andyzha 发表于 2022-5-9 18:42:41

确实存在一个小bug ，选择一个已画的矩形时，会提示：无法转换对象，对象对于云的圆弧而言过大，希望楼主持续完善优化一下。

yanchao316 发表于 2020-5-11 22:42:54

52幕墙设计 发表于 2020-5-10 15:56
我上传了lsp文件，可以直接下载试试

多谢了{:1_1:}

海盗曹 发表于 2013-9-4 11:25:51

占个沙发，多谢楼主分享源码

YANGF85 发表于 2013-9-4 15:03:52

这个不错~~~~~~~

朽木大师 发表于 2013-9-4 15:26:28

这个相当不错，值得学习

yoyoho 发表于 2013-9-4 21:36:20

这个程序不错，学习了!

zgssd 发表于 2013-9-5 08:10:26

很实用，谢谢楼主分享

tjuzkj 发表于 2013-9-5 09:05:39

这个程序不错，学习了!

zlg258369 发表于 2013-9-5 10:19:51

我喜欢这个

午夜的风 发表于 2013-9-5 12:49:40

可以增加画圆形 椭圆形……

成仔 发表于 2013-9-5 16:18:31

程序不错，学习了!
页: [1] 2 3 4 5 6 7
查看完整版本: 动态云线