[分享] (聚合線)(方形)(圓形)雲型線
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
[分享] (聚合線)(方形)(圓形)雲型線
公司有時會使用到雲型線
參考網路上人家寫的 改成自己想要的形式
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)
)
---------------------------------------------------------
參考網路上人家寫的 改成自己想要的形式
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)
)
---------------------------------------------------------
jhjh10403- 一般會員
- 文章總數 : 36
年齡 : 33
來自 : 桃園
職業 : 繪圖人員
愛好 : 繪圖
個性 : 沉默
使用年資 : 新手初學
使用版本 : 新手初學
經驗值 : 4252
威望值 : 21
注冊日期 : 2013-10-02
Tiger&蘋果爸 likes this post
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
這個論壇的權限:
您 無法 在這個版面回復文章