[分享] (聚合線)(方形)(圓形)雲型線

公司有時會使用到雲型線
參考網路上人家寫的 改成自己想要的形式
http://www.theswamp.org/index.php?topic=19615.0
希望可以給有需要的人

circle_revcloud.LSP
---------------------------------------------------------
(Defun C:cirrc ( / opt p1 p2 iph )
(setq p1(getpoint "\n選擇中心點 : "))
       (setq p2(getpoint p1 "\n選擇外徑: "))
       (setvar "plinewid" 0)
       (command "circle" p1 p2)
(command "REVCLOUD" "A"  pause "" "O" (entlast) "N"))
---------------------------------------------------------

pline_revcloud.lsp
---------------------------------------------------------
(defun C:pc ()
 (command "_.PLINE")
 (while (= (getvar "CMDNAMES") "PLINE")
   (command pause)
 )
 (command "pedit" "l" "c" "")
 (command "revcloud" "a" pause "" "" "l" "no")
)
---------------------------------------------------------

rec_revcloud.lsp
---------------------------------------------------------
(Defun C:RECRC ( / opt p1 p2 iph )
(setq p1(getpoint "\n選擇起點: "))
       (setq p2(getcorner p1 "\n選擇對角點: "))
       (setvar "plinewid" 0)
       (command "rectang" p1 p2)
(command "REVCLOUD" "A"  pause "" "O" (entlast) "N"))
---------------------------------------------------------
REVCOULD.lsp
---------------------------------------------------------
(defun C:rv (/ inp )
   (initget "Pline Rectangle Circle") ; ask for input
 (setq Inp (getkword "\n選擇雲型線類型 [聚合線(P)/方形(R)/圓形(C)] <聚合線(P)>: "))


(cond
((= inp "Pline")
(load "pline_revcloud.lsp")
(C:pc)
)
((= inp "Rectangle")
(load "rec_revcloud.lsp")
(C:RECRC)
)
((= inp "Circle")
(load "circle_revcloud.lsp")
(C:cirrc)
)
)
     
(initget "1 2 3") ; ask for input
 (setq Inp (getkword "\n輸入修改版次 [1/2/3] <1>: "))
 (or Inp (setq Inp "1"))
;;  ==============
 (rev inp)
 ;;  ==============
(princ)
)

(defun rev (r# / sp bp ep COOR ID PAUSE TR TX)
 
 (setq sp (getpoint (strcat "選擇版次" r# "擺放位置 ")))
 (setq bp sp)
 (while
   (not (equal ep bp))
    (command "arc" sp pause pause)
    (setq ep (getvar "lastpoint"))
    (setq sp ep)
 )

 ;;  Triangle routine
 (command "polygon" "3" bp "c" "5")
 (setq tr (list (car bp) (+ (cadr bp) 10)))
 (command "ortho" "off" "move" tr "" bp pause)
 (setvar "filedia" 0)
 (setq tx (getvar "lastpoint"))
 (command "color" "BYLAYER" "text" "s" "Standard" "j" "m" tx "10" "0" r#)
 (setq tr (list (car (getvar "lastpoint")) (+ (cadr (getvar "lastpoint")) 10)))
   (= r# "1")
   )
   (= r# "2")
   )
   (= r# "3")
   )
 )
 (setvar "filedia" 1)
)
---------------------------------------------------------