AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~

[討論]請問如何在不同的線段中打相同的字

上一篇主題 下一篇主題 向下

[討論]請問如何在不同的線段中打相同的字

發表 由 x1ben 于 2013-02-23, 08:08

我很久之前寫過一個可以在線段中打字的lisp,用的都還算正常,但是最近發現功能需要在改善,就是要打相同的字在碰不同的線,這會用到迴圈,但是剛好迴圈又是我的罩門(應該也是許多剛接觸lisp新手的罩門),想要新增迴圈又不知該如何修改,還請各位高手幫忙看一下

ps.這個程式已經完成約有10年了
附件
lsp14f.txt 您無權下載這里的附件。(2 Kb) 下載 10 次
avatar
x1ben
初級會員
初級會員

文章總數 : 39
年齡 : 44
來自 : 台北縣
職業 : 電力
愛好 : 拍照
個性 : 樂觀
使用年資 : 10年以上
使用版本 : 2011
積分 : 1
經驗值 : 2715
威望值 : 12
注冊日期 : 2010-11-01
串連貼紙成功 男 射手座 鼠

回頂端 向下

回復: [討論]請問如何在不同的線段中打相同的字

發表 由 tan866 于 2013-04-06, 02:44

;;;修正成批次方式
(defun c:lsp14f ()
(setvar "cmdecho" 0)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(setq txt (getstring "\n文字內容:")
txth (getreal "\n字高<20>:")
)
(setq ss (ssget '((0 . "LINE")))
i -1
)

(while (setq s1 (ssname ss (setq i (1+ i)))
endata (entget S1)
pt10 (cdr (assoc 10 endata))
pt11 (cdr (assoc 11 endata))
ang (angle pt10 pt11)
mid (midpt pt10 pt11)
)

(if (= txth nil) (setq txth 20))
(command "text" "m" mid txth 0.0 txt)
(setq ee_txt (entlast)
txtdata (entget ee_txt) ;求文字資料
)
(setq box (textbox txtdata)
pt1 (car box) ;字外框左下角
pt3 (cadr box)
)
(if (or
(equal ang 0.0 1e-4)
(equal ang Pi 1e-4)
)
(setq dist (distance pt1 pt3))
(setq dy (- (cadr pt3) (cadr pt1)) ;字外框右上角
dist (* dy 1.25)
) )
(setq ptbr1 (polar mid ang (* dist 1.5)) ;剪斷第一點
ptbr2 (polar mid (+ pi ang) (* dist 1.5)) ;剪斷第二點
)
(command "break" S1 ptbr1 ptbr2) ;設碰物件點為第一點
)
(setvar "osmode" old)
(prin1)
)
;**************線段中打字,線段可垂直
avatar
tan866
初級會員
初級會員

文章總數 : 67
年齡 : 40
來自 : 高雄
職業 : 繪圖
愛好 : 騎腳踏車
個性 : 開朗
使用年資 : 5
使用版本 : 2008
積分 : 1
經驗值 : 2894
威望值 : 39
注冊日期 : 2010-10-24
藍鵲346號
男 摩羯座 龍

回頂端 向下

上一篇主題 下一篇主題 回頂端


 
這個論壇的權限:
無法 在這個版面回復文章