本帖最后由 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)
- )
| 
[复制链接]
发表于 2013-9-4 11:19:28
置顶卡
变色卡
显身卡
楼主
很实用，谢谢楼主分享