[分享]一個能顯示面積及長度的LISP程式
[分享]一個能顯示面積及長度的LISP程式
1.新增一個文字文件(.txt),貼上以下內容
3.開啟Autocad工具列中的「載入/卸載應用程式」對話方塊或者執行[appload]
4.選擇該文件位置後載入
5.在指令列key入"am"後,選擇你要的線或面方可使用(但不能選擇圖塊喔)
PS:這是一位建築師給我的LISP
ps:好東西與好朋友分享!!
謝謝程式分享及說明~< 積分 +1>
[公告]關於團隊成員的回文及貢獻
- 代碼:
(defun C:am (/ ss l i totalarea ename obj entarea)
(if (setq ss (ssget))
(progn
(vl-load-com)
(setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
(setq l (sslength ss) i 0 totalarea 0 totlength 0)
(repeat l
(setq ename (ssname ss i))
(setq obj (vlax-ename->vla-object ename))
(if (vlax-property-available-p obj "area")
(setq totalarea (+ (vlax-get-property obj 'area) totalarea))
)
(if (= (cdr (assoc 0 (entget ename))) "MLINE")
(setq totlength (+ totlength (ml-length ename)))
(setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))
)
(setq i (1+ i))
)
(setq text1 (strcat "總面積為 : " (rtos totalarea 2 4) "平方公分")
text2 (strcat "總長度為 : " (rtos totlength 2 4) "公分")
)
(if (setq insertpt (getpoint "\n請輸入文字插入點: "))
(if (setq height (GETREAL "\n請輸入文字高度:"))
(setq insertp1 (vlax-3d-point insertpt)
insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))
textobj1 (vla-addtext modelspace text1 insertp1 height)
textobj2 (vla-addtext modelspace text2 insertp2 height)
)
)
)
)
)
)
(defun ml-length (ename / j d ptlist)
(foreach n (entget ename)
(if (= (car n) 11)
(setq ptlist (cons (cdr n) ptlist))
)
)
(reverse ptlist)
(setq j 0 d 0)
(repeat (1- (length ptlist))
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
(setq j (1+ j))
)
d
)
3.開啟Autocad工具列中的「載入/卸載應用程式」對話方塊或者執行[appload]
4.選擇該文件位置後載入
5.在指令列key入"am"後,選擇你要的線或面方可使用(但不能選擇圖塊喔)
PS:這是一位建築師給我的LISP
ps:好東西與好朋友分享!!

[公告]關於團隊成員的回文及貢獻
- 附件
Tiger&蘋果爸 在 2020-07-08, 09:18 作了第 6 次修改 (原因 : 加分囉~)
bruce79- 初級會員
- 文章總數 : 175
年齡 : 41
來自 : 南投
職業 : 工程師
愛好 : 運動
個性 : O型-樂觀
使用年資 : 5年
使用版本 : 2008
積分 : 3
經驗值 : 5044
威望值 : 57
未回應主題 : 1
注冊日期 : 2008-09-12
JohnnyTsungChen, changuan, jameswangarc and 小東 like this post
回復: [分享]一個能顯示面積及長度的LISP程式
請問是您自己寫的嗎,如果不是請註明出處。
謝謝~
PS:這個程式只適合公分,其他單位要自己換算~
「教學」載入LISP應用程式 APPLOAD指令
http://autocad.bestoforum.net/forum-f7/topic-t111.htm
謝謝~
PS:這個程式只適合公分,其他單位要自己換算~
「教學」載入LISP應用程式 APPLOAD指令
http://autocad.bestoforum.net/forum-f7/topic-t111.htm
回復: [分享]一個能顯示面積及長度的LISP程式
Tiger&蘋果爸 寫到:請問是您自己寫的嗎,如果不是請註明出處。
謝謝~
PS:這個程式只適合公分,其他單位要自己換算~
「教學」載入LISP應用程式 APPLOAD指令
http://autocad.bestoforum.net/forum-f7/topic-t111.htm
PS:這是一位建築師給我的LISP謝謝
bruce79- 初級會員
- 文章總數 : 175
年齡 : 41
來自 : 南投
職業 : 工程師
愛好 : 運動
個性 : O型-樂觀
使用年資 : 5年
使用版本 : 2008
積分 : 3
經驗值 : 5044
威望值 : 57
未回應主題 : 1
注冊日期 : 2008-09-12
回復: [分享]一個能顯示面積及長度的LISP程式
OK~了解!!bruce79 寫到:Tiger&蘋果爸 寫到:請問是您自己寫的嗎,如果不是請註明出處。
謝謝~
PS:這個程式只適合公分,其他單位要自己換算~
「教學」載入LISP應用程式 APPLOAD指令
http://autocad.bestoforum.net/forum-f7/topic-t111.htm
PS:這是一位建築師給我的LISP謝謝
所以一般建築師事務所使用的單位為公分!
回復: [分享]一個能顯示面積及長度的LISP程式
謝謝程式分享
lsP看看
lsP看看

小青蛙- 初級會員
- 文章總數 : 23
年齡 : 53
來自 : 高雄市
職業 : 待業中
愛好 : 上山下海
個性 : 隨性
使用年資 : 斷斷續續
使用版本 : 2012
積分 : 2
經驗值 : 4230
威望值 : 15
注冊日期 : 2009-10-15
回復: [分享]一個能顯示面積及長度的LISP程式
Tiger&蘋果爸 寫到:
PS:這個程式只適合公分,其他單位要自己換算~
小小修改一下!就變成公釐mm
- 代碼:
(defun C:amm (/ ss l i totalarea ename obj entarea)
(if (setq ss (ssget))
(progn
(vl-load-com)
(setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
(setq l (sslength ss) i 0 totalarea 0 totlength 0)
(repeat l
(setq ename (ssname ss i))
(setq obj (vlax-ename->vla-object ename))
(if (vlax-property-available-p obj "area")
(setq totalarea (+ (vlax-get-property obj 'area) totalarea))
)
(if (= (cdr (assoc 0 (entget ename))) "MLINE")
(setq totlength (+ totlength (ml-length ename)))
(setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))
)
(setq i (1+ i))
)
(setq text1 (strcat "總面積為 : " (rtos totalarea 2 4) "平方公釐")
text2 (strcat "總長度為 : " (rtos totlength 2 4) "公釐(mm)")
)
(if (setq insertpt (getpoint "\n請輸入文字插入點: "))
(if (setq height (GETREAL "\n請輸入文字高度:"))
(setq insertp1 (vlax-3d-point insertpt)
insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))
textobj1 (vla-addtext modelspace text1 insertp1 height)
textobj2 (vla-addtext modelspace text2 insertp2 height)
)
)
)
)
)
)
(defun ml-length (ename / j d ptlist)
(foreach n (entget ename)
(if (= (car n) 11)
(setq ptlist (cons (cdr n) ptlist))
)
)
(reverse ptlist)
(setq j 0 d 0)
(repeat (1- (length ptlist))
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
(setq j (1+ j))
)
d
)
judyyai- 管理顧問
- 文章總數 : 7740
年齡 : 43
來自 : 台南
職業 : 機械製圖
愛好 : 電腦相關
個性 : think too much...
使用年資 : 10↑
使用版本 : AC2019(開始於2019年底末月)
AutoCAD基礎篇等級 : 10星級
積分 : 393
最佳解答 : 1
經驗值 : 28864
威望值 : 3555
發帖精華 : 2
回帖精華 : 4
注冊日期 : 2008-11-19
as920029as likes this post
回復: [分享]一個能顯示面積及長度的LISP程式
謝謝JUDY熱心的修改!!judyyai 寫到:Tiger&蘋果爸 寫到:
PS:這個程式只適合公分,其他單位要自己換算~
小小修改一下!就變成公釐mm
- 代碼:
(defun C:amm (/ ss l i totalarea ename obj entarea)
(if (setq ss (ssget))
(progn
(vl-load-com)
(setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
(setq l (sslength ss) i 0 totalarea 0 totlength 0)
(repeat l
(setq ename (ssname ss i))
(setq obj (vlax-ename->vla-object ename))
(if (vlax-property-available-p obj "area")
(setq totalarea (+ (vlax-get-property obj 'area) totalarea))
)
(if (= (cdr (assoc 0 (entget ename))) "MLINE")
(setq totlength (+ totlength (ml-length ename)))
(setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))
)
(setq i (1+ i))
)
(setq text1 (strcat "總面積為 : " (rtos totalarea 2 4) "平方公釐")
text2 (strcat "總長度為 : " (rtos totlength 2 4) "公釐(mm)")
)
(if (setq insertpt (getpoint "\n請輸入文字插入點: "))
(if (setq height (GETREAL "\n請輸入文字高度:"))
(setq insertp1 (vlax-3d-point insertpt)
insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))
textobj1 (vla-addtext modelspace text1 insertp1 height)
textobj2 (vla-addtext modelspace text2 insertp2 height)
)
)
)
)
)
)
(defun ml-length (ename / j d ptlist)
(foreach n (entget ename)
(if (= (car n) 11)
(setq ptlist (cons (cdr n) ptlist))
)
)
(reverse ptlist)
(setq j 0 d 0)
(repeat (1- (length ptlist))
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
(setq j (1+ j))
)
d
)

meet_emily- 高級會員
- 文章總數 : 123
年齡 : 50
來自 : 宜蘭
職業 : 學習
愛好 : 電影,音樂
個性 : 有點呆板,但不古板!有點天真,但不失真!有點強硬,但不強勢!
使用年資 : 6
使用版本 : 2010
積分 : 12
經驗值 : 4820
威望值 : 56
回帖精華 : 1
注冊日期 : 2008-10-12
回復: [分享]一個能顯示面積及長度的LISP程式
感謝分享..... 

DARDAR- 高級會員
- 文章總數 : 294
年齡 : 62
來自 : 台北
職業 : 營造金屬
愛好 : AutoCAD
個性 : 隨和
使用年資 : 5年↑
使用版本 : 2012
積分 : 15
經驗值 : 5185
威望值 : 96
注冊日期 : 2008-05-13
回復: [分享]一個能顯示面積及長度的LISP程式
(if (vlax-property-available-p obj "area")
這判斷式我在vba尚未找到,先用On Error Resume Next替代
附上相對應vba碼
這判斷式我在vba尚未找到,先用On Error Resume Next替代
附上相對應vba碼
- 代碼:
Const pi As Double = 3.14159265358979
Sub ts() '計算面積,長度
Dim ss As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets.Item("ss").Delete
On Error GoTo 0
Set ss = ThisDrawing.SelectionSets.Add("ss")
ss.SelectOnScreen
Dim totalarea As Double
Dim totlength As Double
For Each ent In ss
On Error Resume Next
If IsError(ent.Area) Then MsgBox "此物件不含面積,也不是多重線" _
Else: totalarea = ent.Area + totalarea
On Error GoTo 0
totlength = ent.Length + totlength
Next
totalarea = Format(totalarea, "##,##0.00")
totlength = Format(totlength, "##,##0.00")
text1 = "總面積為 : " & totalarea & " 平方公分"
text2 = "總長度為 : " & totlength & " 公分"
Dim insertp1 As Variant
Dim insertp2 As Variant
Dim Height As Double
insertp1 = ThisDrawing.Utility.GetPoint(, "選擇文字起點")
On Error Resume Next
Height = ThisDrawing.Utility.GetReal("請輸入文字高度:")
On Error GoTo 0
If Height = 0 Then Height = 80
insertp2 = ThisDrawing.Utility.PolarPoint(insertp1, 1.5 * pi, 1.5 * Height)
Set textobj1 = ThisDrawing.ModelSpace.AddText(text1, insertp1, Height)
Set textobj2 = ThisDrawing.ModelSpace.AddText(text2, insertp2, Height)
End Sub
小青蛙- 初級會員
- 文章總數 : 23
年齡 : 53
來自 : 高雄市
職業 : 待業中
愛好 : 上山下海
個性 : 隨性
使用年資 : 斷斷續續
使用版本 : 2012
積分 : 2
經驗值 : 4230
威望值 : 15
注冊日期 : 2009-10-15
W-E-I- 初級會員
- 文章總數 : 63
年齡 : 39
來自 : 台北
職業 : 工程
愛好 : autocad
個性 : 旅遊
使用年資 : 8年左右
使用版本 : 2011
積分 : 1
經驗值 : 4620
威望值 : 0
注冊日期 : 2008-09-26
回復: [分享]一個能顯示面積及長度的LISP程式
趕快來試試看 謝囉
adolescent77- 初級會員
- 文章總數 : 63
年齡 : 41
來自 : 高雄市
職業 : 工程師
愛好 : 電影
個性 : 孤僻
使用年資 : 白天
使用版本 : 2010
積分 : 1
經驗值 : 4338
威望值 : 11
注冊日期 : 2009-11-01
回復: [分享]一個能顯示面積及長度的LISP程式
工作上常要計算,謝謝哦.....
aaaaaa1111- 一般會員
- 文章總數 : 142
年齡 : 44
來自 : 台中
職業 : 行政
愛好 : 繪圖
個性 : 中性
使用年資 : 15年
使用版本 : 2008
經驗值 : 4508
威望值 : 0
注冊日期 : 2009-11-30
回復: [分享]一個能顯示面積及長度的LISP程式
室內設計耶可以用呢~~感謝您!!
MAYA100- 初級會員
- 文章總數 : 321
年齡 : 47
來自 : 台中
職業 : 裝修大抄手
愛好 : 琴棋書畫...都不通啦
個性 : 愛好和平
使用年資 : 6年多
使用版本 : 2006.2008
積分 : 9
經驗值 : 5090
威望值 : 136
注冊日期 : 2009-03-31
回復: [分享]一個能顯示面積及長度的LISP程式
面積計算,蠻多行業都是需要的,感謝分享
howard73- 初級會員
- 文章總數 : 65
年齡 : 38
來自 : 苗栗
職業 : 測量
愛好 : 繪圖
個性 : 隨和
使用年資 : 初學者
使用版本 : 2004
積分 : 2
最佳解答 : 1
經驗值 : 4616
威望值 : 15
注冊日期 : 2008-12-12
回復: [分享]一個能顯示面積及長度的LISP程式
目前工作急需使用
感謝無私的分享
感恩!!
感謝無私的分享
感恩!!
glassshoes2003- 初級會員
- 文章總數 : 151
年齡 : 35
來自 : 彰化縣
職業 : 自由業
愛好 : 電玩 電影 電視
個性 : 隨和
使用年資 : 0.5年
使用版本 : 2008
積分 : 3
經驗值 : 4567
威望值 : 12
注冊日期 : 2009-11-17
回復: [分享]一個能顯示面積及長度的LISP程式
不錯的分享,LISP是一個值得研究的內容,
正好看看內容來學習一些知識也是不著的!
感謝bruce79大大的分享,
同時也感謝Judyyai的貢獻!
正好看看內容來學習一些知識也是不著的!
感謝bruce79大大的分享,
同時也感謝Judyyai的貢獻!
HEMOS- 榮譽顧問
- 文章總數 : 877
年齡 : 48
來自 : 台北
職業 : 土木結構
愛好 : 攝影,音樂,電影
個性 : 和善
使用年資 : 20年以上
使用版本 : 始於R14, 2D順手2008,3D建模與彩現最新版本為佳!
積分 : 27
最佳解答 : 3
經驗值 : 8862
威望值 : 1639
回帖精華 : 1
注冊日期 : 2009-02-23
leoneriol- 榮譽顧問
- 文章總數 : 818
年齡 : 37
來自 : 基隆市七堵區
職業 : 機電工程公司-繪圖(工地)
愛好 : 看小說
個性 : 不愛說話-反應慢
使用年資 : 6年
使用版本 : 2008 & 2012
積分 : 27
經驗值 : 7841
威望值 : 962
發帖精華 : 1
回帖精華 : 1
注冊日期 : 2009-03-12
回復: [分享]一個能顯示面積及長度的LISP程式
計算長度的LISP我有,面積LISP我想看看!
Boss&倫- 中級會員
- 文章總數 : 123
年齡 : 42
來自 : 台北
職業 : 機電
愛好 : 繪圖
個性 : 開朗
使用年資 : 6
使用版本 : AutoCAD2010
積分 : 5
經驗值 : 4477
威望值 : 52
注冊日期 : 2010-03-14
回復: [分享]一個能顯示面積及長度的LISP程式
自己不會寫
至少別人寫也要會用
謝謝大大.
至少別人寫也要會用
謝謝大大.
白金之星- 初級會員
- 文章總數 : 243
年齡 : 43
來自 : 台北
職業 : 工頭
愛好 : AutoCad
個性 : 樂觀
使用年資 : 7
使用版本 : 2008
積分 : 4
經驗值 : 4717
威望值 : 3
未回應主題 : 您有一筆未回應
注冊日期 : 2008-09-22
回復: [分享]一個能顯示面積及長度的LISP程式
我都是計算公尺,很少用到公分和公厘。
Andy.Lin- 初級會員
- 文章總數 : 88
年齡 : 49
來自 : Taipei
職業 : Engineer
愛好 : Play Game
個性 : Happy
使用年資 : 15 years
使用版本 : AUTOCAD 2000~2014
積分 : 3
經驗值 : 4320
威望值 : 99
注冊日期 : 2010-06-07
虹- 一般會員
- 文章總數 : 45
年齡 : 36
來自 : 新竹
職業 : 製造業
愛好 : 游泳
個性 : 隨和
使用年資 : 斷斷續續..學習中
使用版本 : 2010
經驗值 : 4046
威望值 : 0
注冊日期 : 2010-07-01
回覆[分享]一個能顯示面積及長度的LISP程式
謝謝您的分享~
正好有這個需要~謝謝
也學習到原來CAD也可以像是寫程式依樣~輸入指令
正好有這個需要~謝謝
也學習到原來CAD也可以像是寫程式依樣~輸入指令

it930- 初級會員
- 文章總數 : 48
年齡 : 36
來自 : 高雄
職業 : 設計
愛好 : ~看書~~運動~上網~
個性 : 隨和
使用年資 : 5年~
使用版本 : 2014
積分 : 2
經驗值 : 4391
威望值 : 9
注冊日期 : 2009-08-12
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共3頁)
這個論壇的權限:
您 無法 在這個版面回復文章