【發帖精華】在線段自動標示號碼(lisp)
+4
bruce79
judyyai
張譽璋
litung
8 posters
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論 :: 已解決主題精華區
第2頁(共2頁)
【發帖精華】在線段自動標示號碼(lisp)
主題回顧 :
小弟想要作一個,在線段中心點上方標示號碼的功能
測試時,有時是正常的,有時是不正常
在新開的dwg檔中是正常的
若是使用在舊的圖檔,則會不正常
錯誤的地方,在輸文文字那邊都顯示, 0.000000000000000,而小弟要的編號則顯示在下一次的指令那邊。
不知為何會這樣。
是在文字型式設定上有問題嗎?還是程式那邊要作修改。
剛按太快,忘了改標題顏色 ^_^
小弟想要作一個,在線段中心點上方標示號碼的功能
- 代碼:
;;線段自動標示號碼
(defun c:linedt ()
(prompt "依序選擇線段:")
(setq en (ssget))
(setq n (sslength en)
i 0
)
(setq a (getreal "編號:"))
(setq h (getvar "dimtxt"))
(repeat n
(setq en1 (entget (ssname en i))
p1 (cdr (assoc 10 en1))
p2 (cdr (assoc 11 en1))
p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0))
)
(setq an (angle p1 p2))
(if (= an pi)
(setq an (- an pi))
(if (= an (* pi 1.5))
(setq an (* pi 0.5))
(if (and (> an (* pi 0.5)) (< an pi))
(setq an (+ an pi))
)
)
)
(setq an1 (* (/ 180 pi) an)
p3 (polar p3 (+ an (* pi 0.5)) (* h 0.15))
)
(setvar "osmode" 0)
(command "text" "c" p3 h an1 (rtos a))
(setq a (+ a 1)
i (+ i 1)
)
)
)
測試時,有時是正常的,有時是不正常
在新開的dwg檔中是正常的
- 代碼:
指令: _linedt 依序選擇線段:
選取物件: 找到 1 個
選取物件: 找到 1 個,共 2
選取物件: 找到 1 個,共 3
選取物件: 找到 1 個,共 4
選取物件: 編號:3 text
目前的文字型式:「Standard」文字高度: 2.5000 可註解: 否
指定文字的起點或 [對正(J)/型式(S)]: c
指定文字的中心點:
指定高度 <2.5000>: 2.500000000000000
指定文字的旋轉角度 <0>: 0.000000000000000
輸入文字: 3
指令: text
目前的文字型式:「Standard」文字高度: 2.5000 可註解: 否
指定文字的起點或 [對正(J)/型式(S)]: c
指定文字的中心點:
指定高度 <2.5000>: 2.500000000000000
指定文字的旋轉角度 <0>: 0.000000000000000
輸入文字: 4
指令: text
目前的文字型式:「Standard」文字高度: 2.5000 可註解: 否
指定文字的起點或 [對正(J)/型式(S)]: c
指定文字的中心點:
指定高度 <2.5000>: 2.500000000000000
指定文字的旋轉角度 <0>: 0.000000000000000
輸入文字: 5
指令: text
目前的文字型式:「Standard」文字高度: 2.5000 可註解: 否
指定文字的起點或 [對正(J)/型式(S)]: c
指定文字的中心點:
指定高度 <2.5000>: 2.500000000000000
指定文字的旋轉角度 <0>: 0.000000000000000
輸入文字: 6
若是使用在舊的圖檔,則會不正常
- 代碼:
指令: _linedt 依序選擇線段:
選取物件: 指定對角點: 找到 0 個
選取物件: 指定對角點: 找到 1 個
選取物件: 指定對角點: 找到 1 個,共 2
選取物件: 指定對角點: 找到 1 個,共 3
選取物件: 指定對角點: 找到 1 個,共 4
選取物件: 指定對角點: 找到 1 個,共 5
選取物件: 指定對角點: 找到 1 個,共 6
選取物件: 指定對角點: 找到 1 個,共 7
選取物件: 指定對角點: 找到 1 個,共 8
選取物件: 編號:20 text
目前的文字型式:「STANDARD2」文字高度: 2.20 可註解: 否
指定文字的起點或 [對正(J)/型式(S)]: c
指定文字的中心點:
指定文字的旋轉角度 <0>: 10.00000000000000
輸入文字: 0.000000000000000
指令: 20 不明的指令「20」。請按 F1 取得說明。
指令: text
目前的文字型式:「STANDARD2」文字高度: 2.20 可註解: 否
指定文字的起點或 [對正(J)/型式(S)]: c
指定文字的中心點:
指定文字的旋轉角度 <10>: 10.00000000000000
輸入文字: 0.000000000000000
指令: 21 不明的指令「21」。請按 F1 取得說明。
指令: text
目前的文字型式:「STANDARD2」文字高度: 2.20 可註解: 否
指定文字的起點或 [對正(J)/型式(S)]: c
指定文字的中心點:
指定文字的旋轉角度 <10>: 10.00000000000000
輸入文字: 0.000000000000000
指令: 22 不明的指令「22」。請按 F1 取得說明。
指令: text
目前的文字型式:「STANDARD2」文字高度: 2.20 可註解: 否
指定文字的起點或 [對正(J)/型式(S)]: c
指定文字的中心點:
指定文字的旋轉角度 <10>: 10.00000000000000
輸入文字: 0.000000000000000
指令: 23 不明的指令「23」。請按 F1 取得說明。
指令: text
目前的文字型式:「STANDARD2」文字高度: 2.20 可註解: 否
指定文字的起點或 [對正(J)/型式(S)]: c
指定文字的中心點:
指定文字的旋轉角度 <10>: 10.00000000000000
輸入文字: 0.000000000000000
指令: 24 不明的指令「24」。請按 F1 取得說明。
指令: text
目前的文字型式:「STANDARD2」文字高度: 2.20 可註解: 否
指定文字的起點或 [對正(J)/型式(S)]: c
指定文字的中心點:
指定文字的旋轉角度 <10>: 10.00000000000000
輸入文字: 0.000000000000000
指令: 25 不明的指令「25」。請按 F1 取得說明。
指令: text
目前的文字型式:「STANDARD2」文字高度: 2.20 可註解: 否
指定文字的起點或 [對正(J)/型式(S)]: c
指定文字的中心點:
指定文字的旋轉角度 <10>: 10.00000000000000
輸入文字: 0.000000000000000
指令: 26 不明的指令「26」。請按 F1 取得說明。
指令: text
目前的文字型式:「STANDARD2」文字高度: 2.20 可註解: 否
指定文字的起點或 [對正(J)/型式(S)]: c
指定文字的中心點:
指定文字的旋轉角度 <10>: 10.00000000000000
輸入文字: 0.000000000000000
指令: 27 不明的指令「27」。請按 F1 取得說明。
錯誤的地方,在輸文文字那邊都顯示, 0.000000000000000,而小弟要的編號則顯示在下一次的指令那邊。
不知為何會這樣。
是在文字型式設定上有問題嗎?還是程式那邊要作修改。
剛按太快,忘了改標題顏色 ^_^
恭喜您的主題獲選為發帖精華文章! < 積分+1、威望+3 >
[公告]關於論壇的文章價值
Tiger&蘋果爸 在 2010-02-12, 09:35 作了第 3 次修改 (原因 : 精華文章)
litung- 中級會員
- 文章總數 : 226
年齡 : 49
來自 : 高雄市阿蓮區
職業 : PLC設計、HMI規劃、VB6、接案
愛好 : 電腦、卡通、桌球
個性 : 溫和、內向
使用年資 : 現在只出嘴
使用版本 : CAD 2008
積分 : 7
經驗值 : 6376
威望值 : 247
發帖精華 : 1
注冊日期 : 2009-10-30
回復: 【發帖精華】在線段自動標示號碼(lisp)
再次感謝你 ^_^
為何要用角度去判斷呢?而不用座標呢?
程式改寫的真多,可以稍為說一下寫法意思嗎?
另外張大哥怎樣去對lisp作程式的追蹤除錯呢?
有像vba那種可以設中斷點,查看程式狀態的方法嗎?
呵呵,耶害,問題越問越多。
有空再回覆就好了,謝謝你。
為何要用角度去判斷呢?而不用座標呢?
程式改寫的真多,可以稍為說一下寫法意思嗎?
另外張大哥怎樣去對lisp作程式的追蹤除錯呢?
有像vba那種可以設中斷點,查看程式狀態的方法嗎?
呵呵,耶害,問題越問越多。
有空再回覆就好了,謝謝你。
____________________________________________________________________________________
簡單的心,是真正有福
單純的心,是真正的快樂
幸福是種溫馨的感覺
T480 i5-8250U,32GB,SSD:PM961 1TB+T11 25
litung- 中級會員
- 文章總數 : 226
年齡 : 49
來自 : 高雄市阿蓮區
職業 : PLC設計、HMI規劃、VB6、接案
愛好 : 電腦、卡通、桌球
個性 : 溫和、內向
使用年資 : 現在只出嘴
使用版本 : CAD 2008
積分 : 7
經驗值 : 6376
威望值 : 247
發帖精華 : 1
注冊日期 : 2009-10-30
回復: 【發帖精華】在線段自動標示號碼(lisp)
角度來當判斷的依據會比較單純,因為p1到p2與p2到p1角度一定不同,
用座標點會有兩個變異點,就是x軸與y軸的值可能相同,如此一來會增加程式比對及篩選的問題,所以角度是最好的選擇,lisp的除錯本來就是它比較弱的部分,所以我通常會用(print "ok")放置到程式末端已確定程式是哪一行有問題,如果哪一行有問題那一行就不會印出ok而停在錯誤的前一行.所以這種方式是非常老舊確業是最實用的方式,當然寫程式時也不會每行都去做這樣的動作,另一種方式是使用VL編輯器,不過因為它容易當掉所以不太喜歡用VL編輯器.
你之前貼上來的程式,我並沒有改很多是因為它的運作還是正常的,但是這次我就將以下這幾行全刪除了
用座標點會有兩個變異點,就是x軸與y軸的值可能相同,如此一來會增加程式比對及篩選的問題,所以角度是最好的選擇,lisp的除錯本來就是它比較弱的部分,所以我通常會用(print "ok")放置到程式末端已確定程式是哪一行有問題,如果哪一行有問題那一行就不會印出ok而停在錯誤的前一行.所以這種方式是非常老舊確業是最實用的方式,當然寫程式時也不會每行都去做這樣的動作,另一種方式是使用VL編輯器,不過因為它容易當掉所以不太喜歡用VL編輯器.
你之前貼上來的程式,我並沒有改很多是因為它的運作還是正常的,但是這次我就將以下這幾行全刪除了
- 代碼:
(if (= an pi)
(setq an (- an pi))
(if (= an (* pi 1.5))
(setq an (* pi 0.5))
(if (and (> an (* pi 0.5)) (< an pi))
(setq an (+ an pi))
)
)
)
張譽璋- 榮譽顧問
- 文章總數 : 304
年齡 : 54
來自 : 彰化縣員林鎮
職業 : 機械設計工程師/AutoCAD講師/AutoCAD外掛系統開發/AutoCAD書籍作者
愛好 : 旅行及電影
個性 : 風趣健談
使用年資 : 25年
使用版本 : AutoCAD2010/2011/2012/2013
積分 : 20
經驗值 : 7520
威望值 : 641
發帖精華 : 2
回帖精華 : 1
注冊日期 : 2008-05-28
回復: 【發帖精華】在線段自動標示號碼(lisp)
感謝張大哥的解說 ^_^
這個程式或許你家的電控人員也可以用的到,也可以拿給他們用看看。
這個程式或許你家的電控人員也可以用的到,也可以拿給他們用看看。
____________________________________________________________________________________
簡單的心,是真正有福
單純的心,是真正的快樂
幸福是種溫馨的感覺
T480 i5-8250U,32GB,SSD:PM961 1TB+T11 25
litung- 中級會員
- 文章總數 : 226
年齡 : 49
來自 : 高雄市阿蓮區
職業 : PLC設計、HMI規劃、VB6、接案
愛好 : 電腦、卡通、桌球
個性 : 溫和、內向
使用年資 : 現在只出嘴
使用版本 : CAD 2008
積分 : 7
經驗值 : 6376
威望值 : 247
發帖精華 : 1
注冊日期 : 2009-10-30
回復: 【發帖精華】在線段自動標示號碼(lisp)
你說的沒錯我家的電控人員適用,但就拿給他們你還得為他們解釋如何安裝,如何使用,以及原理,就會讓我不敢想像會是什麼樣的情景,所以像你這樣會去研究來解決工作問題的人越來越少了,你要好好加油,總有一天你的努力會看到成果的,最近有一家公司正在跟我接洽我開發的外掛軟體,說不定可以賣個合理的好價錢,這就是投資自己的最大回報你說是不是呢
張譽璋- 榮譽顧問
- 文章總數 : 304
年齡 : 54
來自 : 彰化縣員林鎮
職業 : 機械設計工程師/AutoCAD講師/AutoCAD外掛系統開發/AutoCAD書籍作者
愛好 : 旅行及電影
個性 : 風趣健談
使用年資 : 25年
使用版本 : AutoCAD2010/2011/2012/2013
積分 : 20
經驗值 : 7520
威望值 : 641
發帖精華 : 2
回帖精華 : 1
注冊日期 : 2008-05-28
回復: 【發帖精華】在線段自動標示號碼(lisp)
小弟都是想讓工作簡單一點,方便一點,才會去學一點點東西。
剛剛又新加了一個簡單的功能,標纖(文字+數字),方便作一些東西的標纖編號。這次不用再麻煩 謝大哥了
分享給有需要用的電控人員。
剛剛又新加了一個簡單的功能,標纖(文字+數字),方便作一些東西的標纖編號。這次不用再麻煩 謝大哥了
分享給有需要用的電控人員。
- 代碼:
(defun c:linedt (/ hold old_start_number)
(setq cmd (getvar "cmdecho"))
(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(princ "\nLINEDT 線條自動加編號")
(INITGET "L T")
(PRINC "\N 功能選擇 [線段<L>/標纖<T>] <L>:")
(SETQ SF (GETKWORD))
(COND
((= SF "L")
(setq Title "")
)
((= SF "T")
(setq Title (getstring "\n請輸入標纖:"))
)
)
(setq old_start_number start_number)
(if (null old_start_number)
(setq old_start_number 1)
)
(princ "\n起始編號 <")
(princ old_start_number)
(princ "> :")
(setq start_number (getint))
(if (null start_number)
(setq start_number old_start_number)
)
(setq hold CharHigh)
(if (null hold)
(setq hold 2.2)
)
(princ "\n請輸入字高 <")
(princ hold)
(princ "> :")
(setq CharHigh (getreal))
(if (null CharHigh)
(setq CharHigh hold)
)
(INITGET "L C R")
(PRINC "\n選擇線號位置 左邊(L)/中間(C)/右邊(R) <C>:")
(SETQ SelectPoint (GETKWORD))
(IF (NULL SelectPoint)
(SETQ SelectPoint "C")
)
(prompt "\n依序選擇線段:")
(setq en (ssget))
(setq n (sslength en)
i 0
)
(repeat n
(setq en1 (entget (ssname en i))
p1 (cdr (assoc 10 en1))
p2 (cdr (assoc 11 en1))
p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0))
)
(setq an (angle p1 p2))
(setq am (angle p2 p1))
(if (> an am)
(setq CharAngle (* (/ 180 pi) am))
(setq CharAngle (* (/ 180 pi) an))
)
(if (> an am)
(setq pp1 (polar p1 (+ am (* pi 0.5)) (* CharHigh 0.5))
pp1 (polar pp1 (+ am (* pi 1.0)) 2.0)
pp2 (polar p2 (+ am (* pi 0.5)) (* CharHigh 0.5))
pp2 (polar pp2 (+ am (* pi 0.0)) 2.0)
)
(setq pp1 (polar p1 (+ an (* pi 0.5)) (* CharHigh 0.5))
pp1 (polar pp1 (+ an (* pi 0.0)) 2.0)
pp2 (polar p2 (+ an (* pi 0.5)) (* CharHigh 0.5))
pp2 (polar pp2 (+ an (* pi 1.0)) 2.0)
)
)
(if (> an am)
(setq p3 (polar p3 (+ am (* pi 0.5)) (* CharHigh 0.5)))
(setq p3 (polar p3 (+ an (* pi 0.5)) (* CharHigh 0.5)))
)
(setvar "osmode" 0)
(COND
((= SelectPoint "L")
(if (> an am)
(SETq CenterPoint pp2)
(SETq CenterPoint pp1)
)
)
((= SelectPoint "C")
(SETQ CenterPoint p3)
)
((= SelectPoint "R")
(if (> an am)
(SETQ CenterPoint pp1)
(SETQ CenterPoint pp2)
)
)
)
(princ "OK")
(command "text"
"c"
CenterPoint
CharHigh
CharAngle
(strcat title (rtos start_number))
)
(setq start_number
(+ start_number 1)
i (+ i 1)
)
)
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
(princ)
)
____________________________________________________________________________________
簡單的心,是真正有福
單純的心,是真正的快樂
幸福是種溫馨的感覺
T480 i5-8250U,32GB,SSD:PM961 1TB+T11 25
litung- 中級會員
- 文章總數 : 226
年齡 : 49
來自 : 高雄市阿蓮區
職業 : PLC設計、HMI規劃、VB6、接案
愛好 : 電腦、卡通、桌球
個性 : 溫和、內向
使用年資 : 現在只出嘴
使用版本 : CAD 2008
積分 : 7
經驗值 : 6376
威望值 : 247
發帖精華 : 1
注冊日期 : 2009-10-30
回復: 【發帖精華】在線段自動標示號碼(lisp)
(PRINC "\N 功能選擇 [線段/標纖] :")
你這行還是有錯喔!
\n是小寫,不可以用大寫的
文字的位置還要再調正一下會更好.
你這行還是有錯喔!
\n是小寫,不可以用大寫的
文字的位置還要再調正一下會更好.
張譽璋- 榮譽顧問
- 文章總數 : 304
年齡 : 54
來自 : 彰化縣員林鎮
職業 : 機械設計工程師/AutoCAD講師/AutoCAD外掛系統開發/AutoCAD書籍作者
愛好 : 旅行及電影
個性 : 風趣健談
使用年資 : 25年
使用版本 : AutoCAD2010/2011/2012/2013
積分 : 20
經驗值 : 7520
威望值 : 641
發帖精華 : 2
回帖精華 : 1
注冊日期 : 2008-05-28
回復: 【發帖精華】在線段自動標示號碼(lisp)
了解,謝謝提醒。原來還要注意大小寫哦!
在Visual LISP檢查時,並沒有提示錯誤,所以沒去注意它。
今天在公司測試時,又發現一個問題了(新增標纖延伸的)。
當加上標纖時,字串會變長,此時字串會超出線段的左右邊界。
右邊界可以用text的向右對齊解決,中心也ok,只剩左邊會有問題。
text沒有向左對齊的參數可以用。
在Visual LISP檢查時,並沒有提示錯誤,所以沒去注意它。
今天在公司測試時,又發現一個問題了(新增標纖延伸的)。
當加上標纖時,字串會變長,此時字串會超出線段的左右邊界。
右邊界可以用text的向右對齊解決,中心也ok,只剩左邊會有問題。
text沒有向左對齊的參數可以用。
- 代碼:
(defun c:linedt (/ hold old_start_number)
(setq cmd (getvar "cmdecho"))
(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(princ "\n LINEDT 線條自動加編號")
(INITGET "L T")
(PRINC "\n 功能選擇 [線段(L)/標纖(T)] <L>:")
(setq title "")
(SETQ SF (GETKWORD))
(COND
((= SF "L")
)
((= SF "T")
(setq Title (getstring "\n 請輸入標纖:"))
)
)
(setq old_start_number start_number)
(if (null old_start_number)
(setq old_start_number 1)
)
(princ "\n 起始編號 <")
(princ old_start_number)
(princ "> :")
(setq start_number (getint))
(if (null start_number)
(setq start_number old_start_number)
)
(setq hold CharHigh)
(if (null hold)
(setq hold 2.2)
)
(princ "\n 請輸入字高 <")
(princ hold)
(princ "> :")
(setq CharHigh (getreal))
(if (null CharHigh)
(setq CharHigh hold)
)
(INITGET "L C R")
(PRINC "\n 選擇線號位置 [左邊(L)/中間(C)/右邊(R)] <C>:")
(SETQ SelectPoint (GETKWORD))
(IF (NULL SelectPoint)
(SETQ SelectPoint "C")
)
(prompt "\n 依序選擇線段:")
(setq en (ssget))
(setq n (sslength en)
i 0
)
(repeat n
(setq en1 (entget (ssname en i))
p1 (cdr (assoc 10 en1))
p2 (cdr (assoc 11 en1))
p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0))
)
(setq an (angle p1 p2))
(setq am (angle p2 p1))
(if (> an am)
(setq CharAngle (* (/ 180 pi) am))
(setq CharAngle (* (/ 180 pi) an))
)
(if (> an am)
(setq pp1 (polar p1 (+ am (* pi 0.5)) (* CharHigh 0.5))
pp1 (polar pp1 (+ am (* pi 1.0)) 2.0)
pp2 (polar p2 (+ am (* pi 0.5)) (* CharHigh 0.5))
pp2 (polar pp2 (+ am (* pi 0.0)) 2.0)
)
(setq pp1 (polar p1 (+ an (* pi 0.5)) (* CharHigh 0.5))
pp1 (polar pp1 (+ an (* pi 0.0)) 2.0)
pp2 (polar p2 (+ an (* pi 0.5)) (* CharHigh 0.5))
pp2 (polar pp2 (+ an (* pi 1.0)) 2.0)
)
)
(if (> an am)
(setq p3 (polar p3 (+ am (* pi 0.5)) (* CharHigh 0.5)))
(setq p3 (polar p3 (+ an (* pi 0.5)) (* CharHigh 0.5)))
)
(setvar "osmode" 0)
(COND
((= SelectPoint "L")
(if (> an am)
(SETq CenterPoint pp2)
(SETq CenterPoint pp1)
)
;;;(SETQ texttype "c");;;沒有靠左的選項,暫時使用"置中"取代,再以move移動距離
)
((= SelectPoint "C")
(SETQ CenterPoint p3)
(SETQ texttype "C")
)
((= SelectPoint "R")
(if (> an am)
(SETQ CenterPoint pp1)
(SETQ CenterPoint pp2)
)
(setq texttype "R")
)
)
(command "text"
(if (= selectpoint L) "" texttype)
CenterPoint
CharHigh
CharAngle
(strcat title (rtos start_number))
)
(setq start_number
(+ start_number 1)
i (+ i 1)
)
)
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
(princ)
)
____________________________________________________________________________________
簡單的心,是真正有福
單純的心,是真正的快樂
幸福是種溫馨的感覺
T480 i5-8250U,32GB,SSD:PM961 1TB+T11 25
litung- 中級會員
- 文章總數 : 226
年齡 : 49
來自 : 高雄市阿蓮區
職業 : PLC設計、HMI規劃、VB6、接案
愛好 : 電腦、卡通、桌球
個性 : 溫和、內向
使用年資 : 現在只出嘴
使用版本 : CAD 2008
積分 : 7
經驗值 : 6376
威望值 : 247
發帖精華 : 1
注冊日期 : 2009-10-30
回復: [己解決]在線段自動標示號碼(lisp)
真的很方便的lisp
感謝大家的分享!!
感謝大家的分享!!
bruce79- 初級會員
- 文章總數 : 186
年齡 : 45
來自 : 南投
職業 : 工程師
愛好 : 運動
個性 : O型-樂觀
使用年資 : 5年
使用版本 : 2008
積分 : 3
經驗值 : 6517
威望值 : 117
未回應主題 : 1
注冊日期 : 2008-09-12
回復: 【發帖精華】在線段自動標示號碼(lisp)
我也下載來研究了,感謝前輩無私的分享.
ginse0727- 高級會員
- 文章總數 : 256
年齡 : 50
來自 : 台北巿
職業 : 帷幕牆
愛好 : 電玩,漫畫,網路小說
個性 : 宅男/正直/死腦筋
使用年資 : 退伍後工作迄今,10年以上
使用版本 : 2012
積分 : 14
經驗值 : 6828
威望值 : 500
發帖精華 : 1
注冊日期 : 2010-07-13
回復: 【發帖精華】在線段自動標示號碼(lisp)
可以判斷文字寫出方式
(if (> (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0)
(command "TEXT" pt h "" "xxx")
(command "TEXT" pt "" "xxx")
)
(if (> (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0)
(command "TEXT" pt h "" "xxx")
(command "TEXT" pt "" "xxx")
)
lsj- 初級會員
- 文章總數 : 43
年齡 : 59
來自 : 桃園
職業 : 營建工程
愛好 : 閒
個性 : 懶
使用年資 : 10↑
使用版本 : 2008
積分 : 2
經驗值 : 5505
威望值 : 110
注冊日期 : 2010-06-28
回復: 【發帖精華】在線段自動標示號碼(lisp)
提供建議,請參考
(defun c:linedt (/ hold old_start_number)
(setq cmd (getvar "cmdecho"))
(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(princ "\n LINEDT 線條自動加編號")
(INITGET "L T")
(PRINC "\n 功能選擇 [線段(L)/標纖(T)]:")
(setq title "")
(SETQ SF (GETKWORD))
(COND
((= SF "L")
)
((= SF "T")
(setq Title (getstring "\n 請輸入標纖:"))
)
)
(setq old_start_number start_number)
(if (null old_start_number)
(setq old_start_number 1)
)
(princ "\n 起始編號 <")
(princ old_start_number)
(princ "> :")
(setq start_number (getint))
(if (null start_number)
(setq start_number old_start_number)
)
(setq hold CharHigh)
(if (null hold)
(setq hold 2.2)
)
(princ "\n 請輸入字高 <") ;;以下三行可以併在GETREAL後,看起來較明確
(princ hold)
(princ "> :")
(setq CharHigh (getreal))
(if (null CharHigh)
(setq CharHigh hold)
)
(INITGET "L C R")
(PRINC "\n 選擇線號位置 [左邊(L)/中間(C)/右邊(R)]:")
(SETQ SelectPoint (GETKWORD))
(IF (NULL SelectPoint)
(SETQ SelectPoint "C")
)
(prompt "\n 依序選擇線段:")
(setq en (ssget)) ;;(SETQ EN (SSGET '((0 . "LINE"))))依程式需求只取"LINE"避免群碼錯誤處理,再延伸可過濾圖層
(setq n (sslength en)
i 0
)
(repeat n
(setq en1 (entget (ssname en i))
p1 (cdr (assoc 10 en1))
p2 (cdr (assoc 11 en1))
p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0))
)
(setq an (angle p1 p2))
(setq am (angle p2 p1))
(if (> an am) ;;角度判斷及寫出位置不知你具體需求,無法評論,只覺得可以更簡化
(setq CharAngle (* (/ 180 pi) am))
(setq CharAngle (* (/ 180 pi) an))
)
(if (> an am)
(setq pp1 (polar p1 (+ am (* pi 0.5)) (* CharHigh 0.5))
pp1 (polar pp1 (+ am (* pi 1.0)) 2.0)
pp2 (polar p2 (+ am (* pi 0.5)) (* CharHigh 0.5))
pp2 (polar pp2 (+ am (* pi 0.0)) 2.0)
)
(setq pp1 (polar p1 (+ an (* pi 0.5)) (* CharHigh 0.5))
pp1 (polar pp1 (+ an (* pi 0.0)) 2.0)
pp2 (polar p2 (+ an (* pi 0.5)) (* CharHigh 0.5))
pp2 (polar pp2 (+ an (* pi 1.0)) 2.0)
)
)
(if (> an am)
(setq p3 (polar p3 (+ am (* pi 0.5)) (* CharHigh 0.5)))
(setq p3 (polar p3 (+ an (* pi 0.5)) (* CharHigh 0.5)))
)
(setvar "osmode" 0) ;;放在前面才好維護,在此處也一直重覆執行沒意義
(COND
((= SelectPoint "L")
(if (> an am)
(SETq CenterPoint pp2)
(SETq CenterPoint pp1)
)
;;;(SETQ texttype "c");;;沒有靠左的選項,暫時使用"置中"取代,再以move移動距離
) ;;目的達到也OK,TEXT有"BL"可用,變通一下就行,可不必繞路
((= SelectPoint "C")
(SETQ CenterPoint p3)
(SETQ texttype "C")
)
((= SelectPoint "R")
(if (> an am)
(SETQ CenterPoint pp1)
(SETQ CenterPoint pp2)
)
(setq texttype "R")
)
)
(command "text"
(if (= selectpoint L) "" texttype)
CenterPoint
CharHigh
CharAngle
(strcat title (rtos start_number)) ;;start_number為整數在此不受影響,但這樣寫法最好設DIMZIN=8,可抑制零值,或用ITOA
)
(setq start_number
(+ start_number 1)
i (+ i 1)
)
) ;;可用座標點加入排序處理,在圖面顯示上較有章法
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
(princ)
)
(defun c:linedt (/ hold old_start_number)
(setq cmd (getvar "cmdecho"))
(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(princ "\n LINEDT 線條自動加編號")
(INITGET "L T")
(PRINC "\n 功能選擇 [線段(L)/標纖(T)]
(setq title "")
(SETQ SF (GETKWORD))
(COND
((= SF "L")
)
((= SF "T")
(setq Title (getstring "\n 請輸入標纖:"))
)
)
(setq old_start_number start_number)
(if (null old_start_number)
(setq old_start_number 1)
)
(princ "\n 起始編號 <")
(princ old_start_number)
(princ "> :")
(setq start_number (getint))
(if (null start_number)
(setq start_number old_start_number)
)
(setq hold CharHigh)
(if (null hold)
(setq hold 2.2)
)
(princ "\n 請輸入字高 <") ;;以下三行可以併在GETREAL後,看起來較明確
(princ hold)
(princ "> :")
(setq CharHigh (getreal))
(if (null CharHigh)
(setq CharHigh hold)
)
(INITGET "L C R")
(PRINC "\n 選擇線號位置 [左邊(L)/中間(C)/右邊(R)]
(SETQ SelectPoint (GETKWORD))
(IF (NULL SelectPoint)
(SETQ SelectPoint "C")
)
(prompt "\n 依序選擇線段:")
(setq en (ssget)) ;;(SETQ EN (SSGET '((0 . "LINE"))))依程式需求只取"LINE"避免群碼錯誤處理,再延伸可過濾圖層
(setq n (sslength en)
i 0
)
(repeat n
(setq en1 (entget (ssname en i))
p1 (cdr (assoc 10 en1))
p2 (cdr (assoc 11 en1))
p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0))
)
(setq an (angle p1 p2))
(setq am (angle p2 p1))
(if (> an am) ;;角度判斷及寫出位置不知你具體需求,無法評論,只覺得可以更簡化
(setq CharAngle (* (/ 180 pi) am))
(setq CharAngle (* (/ 180 pi) an))
)
(if (> an am)
(setq pp1 (polar p1 (+ am (* pi 0.5)) (* CharHigh 0.5))
pp1 (polar pp1 (+ am (* pi 1.0)) 2.0)
pp2 (polar p2 (+ am (* pi 0.5)) (* CharHigh 0.5))
pp2 (polar pp2 (+ am (* pi 0.0)) 2.0)
)
(setq pp1 (polar p1 (+ an (* pi 0.5)) (* CharHigh 0.5))
pp1 (polar pp1 (+ an (* pi 0.0)) 2.0)
pp2 (polar p2 (+ an (* pi 0.5)) (* CharHigh 0.5))
pp2 (polar pp2 (+ an (* pi 1.0)) 2.0)
)
)
(if (> an am)
(setq p3 (polar p3 (+ am (* pi 0.5)) (* CharHigh 0.5)))
(setq p3 (polar p3 (+ an (* pi 0.5)) (* CharHigh 0.5)))
)
(setvar "osmode" 0) ;;放在前面才好維護,在此處也一直重覆執行沒意義
(COND
((= SelectPoint "L")
(if (> an am)
(SETq CenterPoint pp2)
(SETq CenterPoint pp1)
)
;;;(SETQ texttype "c");;;沒有靠左的選項,暫時使用"置中"取代,再以move移動距離
) ;;目的達到也OK,TEXT有"BL"可用,變通一下就行,可不必繞路
((= SelectPoint "C")
(SETQ CenterPoint p3)
(SETQ texttype "C")
)
((= SelectPoint "R")
(if (> an am)
(SETQ CenterPoint pp1)
(SETQ CenterPoint pp2)
)
(setq texttype "R")
)
)
(command "text"
(if (= selectpoint L) "" texttype)
CenterPoint
CharHigh
CharAngle
(strcat title (rtos start_number)) ;;start_number為整數在此不受影響,但這樣寫法最好設DIMZIN=8,可抑制零值,或用ITOA
)
(setq start_number
(+ start_number 1)
i (+ i 1)
)
) ;;可用座標點加入排序處理,在圖面顯示上較有章法
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
(princ)
)
lsj- 初級會員
- 文章總數 : 43
年齡 : 59
來自 : 桃園
職業 : 營建工程
愛好 : 閒
個性 : 懶
使用年資 : 10↑
使用版本 : 2008
積分 : 2
經驗值 : 5505
威望值 : 110
注冊日期 : 2010-06-28
回復: 【發帖精華】在線段自動標示號碼(lisp)
我只針對你的需求更改,
註解下面是改的部份,
祝你好運!
(defun c:linedt (/ hold aold)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(princ "\nLINEDT 線條自動加編號")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(setq aold a)
;(if (null aold)
; (setq aold 1)
;)
(if (null a) (setq a 1))
;(princ "\n起始編號 <")
;(princ aold)
;(princ "> :")
;(setq a (getint))
(setq aold (getint (strcat "\n起始編號 <" (itoa a) "> :")))
;(if (null a)
; (setq a aold)
;)
(if aold (setq a aold))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;先檢查目前字型是否已設定字高
(setq chk 0)
(if (/= (setq chk (cdr (assoc 40 (tblsearch "STYLE" (getvar "textstyle"))))) 0)
(progn
(alert "目前字型高度不是0!")
(setq h chk)
)
(progn
;(setq hold h)
;(if (null hold)
; (setq hold 2.2)
;)
(if (null h) (setq h 2.2))
;(princ "\n請輸入字高 <")
;(princ hold)
;(princ "> :")
;(setq h (getreal))
(setq hold (getdist (strcat "\n請輸入字高 <" (rtos h) "> :")))
;(if (null h)
; (setq h hold)
;)
(if hold (setq h hold))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(while (setq en0 (entsel "\n選取線條:"))
(setq en1 (entget (car en0)))
(if (/= (cdr (assoc 0 en1)) "LINE")
(alert "請選取線!")
(progn
(setq p1 (cdr (assoc 10 en1))
p2 (cdr (assoc 11 en1))
p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0))
)
(setq an (angle p1 p2))
(if (= an pi)
(setq an (- an pi))
(if (= an (* pi 1.5))
(setq an (* pi 0.5))
(if (and (> an (* pi 0.5)) (< an pi))
(setq an (+ an pi))
)
)
)
(setq an1 (* (/ 180 pi) an)
p3 (polar p3 (+ an (* pi 0.5)) (* h 0.15))
)
(setvar "osmode" 0)
;;(command "text" "c" p3 h an1 (rtos a))
(if (= chk 0)
(command "text" "c" p3 h an1 (rtos a))
(command "text" "c" p3 an1 (rtos a))
)
(setq a (+ a 1))
(setvar "cmdecho" cmd)
)
)
)
(princ)
)
註解下面是改的部份,
祝你好運!
(defun c:linedt (/ hold aold)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(princ "\nLINEDT 線條自動加編號")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(setq aold a)
;(if (null aold)
; (setq aold 1)
;)
(if (null a) (setq a 1))
;(princ "\n起始編號 <")
;(princ aold)
;(princ "> :")
;(setq a (getint))
(setq aold (getint (strcat "\n起始編號 <" (itoa a) "> :")))
;(if (null a)
; (setq a aold)
;)
(if aold (setq a aold))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;先檢查目前字型是否已設定字高
(setq chk 0)
(if (/= (setq chk (cdr (assoc 40 (tblsearch "STYLE" (getvar "textstyle"))))) 0)
(progn
(alert "目前字型高度不是0!")
(setq h chk)
)
(progn
;(setq hold h)
;(if (null hold)
; (setq hold 2.2)
;)
(if (null h) (setq h 2.2))
;(princ "\n請輸入字高 <")
;(princ hold)
;(princ "> :")
;(setq h (getreal))
(setq hold (getdist (strcat "\n請輸入字高 <" (rtos h) "> :")))
;(if (null h)
; (setq h hold)
;)
(if hold (setq h hold))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(while (setq en0 (entsel "\n選取線條:"))
(setq en1 (entget (car en0)))
(if (/= (cdr (assoc 0 en1)) "LINE")
(alert "請選取線!")
(progn
(setq p1 (cdr (assoc 10 en1))
p2 (cdr (assoc 11 en1))
p3 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0))
)
(setq an (angle p1 p2))
(if (= an pi)
(setq an (- an pi))
(if (= an (* pi 1.5))
(setq an (* pi 0.5))
(if (and (> an (* pi 0.5)) (< an pi))
(setq an (+ an pi))
)
)
)
(setq an1 (* (/ 180 pi) an)
p3 (polar p3 (+ an (* pi 0.5)) (* h 0.15))
)
(setvar "osmode" 0)
;;(command "text" "c" p3 h an1 (rtos a))
(if (= chk 0)
(command "text" "c" p3 h an1 (rtos a))
(command "text" "c" p3 an1 (rtos a))
)
(setq a (+ a 1))
(setvar "cmdecho" cmd)
)
)
)
(princ)
)
回復: 【發帖精華】在線段自動標示號碼(lisp)
好久沒來了,收到回帖通知,又來逛逛 ^_^
這個程式的原本需求為:使用在電控線路的線號標示用。
標示流水號時,會因設計的不同;有時須標示在線段的左邊或是中間或是右邊。有時會在流水號的前面再加上文字,如X0001,X0002,X0003...
會去計算角度問題是因:
線段畫法不一樣,有時是從左邊拉到右邊,有時是從右邊拉到左邊。
希望不管線段怎麼畫,當選擇方向時(左/中/右),所有的標示都要在同一邊。
以上是當初在設計電控迴路時,所想到的,才會有此程式的需求產生。
這個程式的原本需求為:使用在電控線路的線號標示用。
標示流水號時,會因設計的不同;有時須標示在線段的左邊或是中間或是右邊。有時會在流水號的前面再加上文字,如X0001,X0002,X0003...
會去計算角度問題是因:
線段畫法不一樣,有時是從左邊拉到右邊,有時是從右邊拉到左邊。
希望不管線段怎麼畫,當選擇方向時(左/中/右),所有的標示都要在同一邊。
以上是當初在設計電控迴路時,所想到的,才會有此程式的需求產生。
____________________________________________________________________________________
簡單的心,是真正有福
單純的心,是真正的快樂
幸福是種溫馨的感覺
T480 i5-8250U,32GB,SSD:PM961 1TB+T11 25
litung- 中級會員
- 文章總數 : 226
年齡 : 49
來自 : 高雄市阿蓮區
職業 : PLC設計、HMI規劃、VB6、接案
愛好 : 電腦、卡通、桌球
個性 : 溫和、內向
使用年資 : 現在只出嘴
使用版本 : CAD 2008
積分 : 7
經驗值 : 6376
威望值 : 247
發帖精華 : 1
注冊日期 : 2009-10-30
回復: 【發帖精華】在線段自動標示號碼(lisp)
程式的寫法,每個人都有不同的方式和習慣,前面幾位為網友改了一堆內容,其實還是相同的結果,對運作來講並沒有提升多大的效率,不過兩位網友的熱心倒是可以讓其他網友了解,同樣的功能卻有著麼多樣的寫法,可以提供給各位想學lisp的網友參考,但是不是每個人都會理解這樣的寫法,所以寫程式還是要以各位的經驗及習慣為主,在不同的領域是有不同的使用習慣及問題的 。
張譽璋- 榮譽顧問
- 文章總數 : 304
年齡 : 54
來自 : 彰化縣員林鎮
職業 : 機械設計工程師/AutoCAD講師/AutoCAD外掛系統開發/AutoCAD書籍作者
愛好 : 旅行及電影
個性 : 風趣健談
使用年資 : 25年
使用版本 : AutoCAD2010/2011/2012/2013
積分 : 20
經驗值 : 7520
威望值 : 641
發帖精華 : 2
回帖精華 : 1
注冊日期 : 2008-05-28
回復: 【發帖精華】在線段自動標示號碼(lisp)
好程式,不會寫,但是會用,謝謝
poiuyy- 初級會員
- 文章總數 : 226
年齡 : 50
來自 : 台中
職業 : 小監
愛好 : 電影
個性 : 中庸
使用年資 : 5
使用版本 : 2010
積分 : 2
經驗值 : 4773
威望值 : 84
注冊日期 : 2014-06-24
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論 :: 已解決主題精華區
第2頁(共2頁)
這個論壇的權限:
您 無法 在這個版面回復文章