求一个云线的lisp
-->1. 框选生成云线，云线图层为当前日期，每天云线颜色不一样-->2. 图层非打印，云线绘制完点击外面某点，绘制直线，
如果不输批注，按空格，则默认文字为（某月某日修改）
-->3. 启动命令R1(框选画云线),R2(选择对象云线),R12(设置云线宽度)
求程序``````````` 凑了一个，自己改下适合自己用的就行了
(defun c:yun (/ #err99 $orr c pt pt2 r snap);云线原作者 langjs
(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")
)
(while (progn
(if (null rbak)
(setq rbak (* 0.8 (getvar "DIMSCALE") (getvar "DIMTXT")))
)
(initget "A C ")
(if (= (setq pt (getpoint "\n指定第一个角点或 [弧长(A)/颜色(C)]："))
"A"
)
(setq r (getreal (strcat "\n指定弧长 <" (rtos rbak 2 3) ">:")))
(if (= pt "C")
(setq cdbak (cdr (car (acad_truecolordlg '(62 . 1)))))
)
)
(not (= (type pt) 'list))
)
)
(if r
(setq rbak r)
)
(if cdbak
(command "color" cdbak)
(command "color" 1)
)
(while (not (setq pt2 (getcorner pt "\n指定另一个角点："))))
(command "layer" "s" "gm3" "")
(command "_rectang" pt pt2)
(command "layer" "s" "gm1" "")
(command "_revcloud" "A" rbak rbak "O" "" (entlast) "N")
(setvar "CECOLOR" c)
;--文字标示
(setq va (getvar "lunits"))
(setq date0 (menucmd "m=$(edtime,$(getvar,date),日期:YYYY-MO-DD:)" ))
(if (= va 2) (progn (setq vaa 3) (setq vab 6) )
(progn (setq vaa 0.125) (setq vab 0.25) ) )
(PROGN
(setq le1 (getpoint "\n Specify the first point: "))
(setq le2 (getpoint "\n Specify the second point: "))
(setq str (getstring "\n输入说明："))
(command "qleader" le1 le2"" "50"date0str"" )
)
(setq ssa (ssget "X" '((0 . "LWPOLYLINE") (8 . "gm3"))))
(command "erase" ssa "" )
(setvar "OSMODE" snap)
(command ".UNDO" "E")
(setq *error* $orr)
(princ)
)
页:
[1]