[分享]一個能顯示面積及長度的LISP程式

主題回顧 :

1.新增一個文字文件(.txt),貼上以下內容

代碼:

(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
)

2.在將該文件副檔名改為(.lsp) (檔名:am.lsp)
3.開啟Autocad工具列中的「載入/卸載應用程式」對話方塊或者執行[appload]
4.選擇該文件位置後載入
5.在指令列key入"am"後,選擇你要的線或面方可使用(但不能選擇圖塊喔)
PS:這是一位建築師給我的LISP
ps:好東西與好朋友分享!!

---

蘋果爸補充:
每個CAD版本可能會有些差異，每個人使用方式也要討論及了解，才能知道問題在哪!
是否有開啟一張新圖來做測試，如果可以測試其他電腦的CAD版本。
我這裡使用2023版本操作沒有問題!


謝謝程式分享及說明~< 積分 +1>

[公告]關於團隊成員的回文及貢獻

來試試

感謝分享!!

感謝分享，剛好非常需要這個功能

感謝分享，工作上剛好用得到!

來試看看...對於蒜面積幫助

請問那個程式碼怎麼複製....到筆記本檔

c1140c33 寫到:請問那個程式碼怎麼複製....到筆記本檔

已經重新上傳附件下載了，請前往下載!

感謝分享!計算材料數量很方便

神救援!!!!謝謝分享剛剛試了一下!!!超級快速!
本來都要把圖形連接起來再做修剪跟面域..現在快速好多  
謝謝!!

感謝前輩分享,剛好有需要先來試試看了

以西杰 寫到:執行後掛掉
跑出下面的指令 我用的是 CAD2010
指令: am
選取物件: 找到 1 個
選取物件:
請輸入文字插入點:
請輸入文字高度:50
#  VLA-OBJECT IAcadText 16f961e4

每個CAD版本可能會有些差異，每個人使用方式也要討論及了解，才能知道問題在哪!
是否有開啟一張新圖來做測試，如果可以測試其他電腦的CAD版本。
我這裡使用2023版本操作沒有問題!

很實用的功能，感謝分享~

謝謝您的分享，還有熱心的人士修改，我來試用看看

這是俺跑出來的結果
還請指教

ganlinlaw 寫到:這是俺跑出來的結果
還請指教

因為程式碼中有中文緣故，有時候會編碼關係造成亂碼
LSP程式再用Visual LISP編輯器，開啟後儲存來使用

AutoLISP 與 Visual LISP 概述
https://www.autocad-tw.com/t4511-topic

感謝大大的分享 剛剛抓來試了一下 真的相當好用~

很實用,謝謝版大的分享

感謝大大 ，十分受用!!!自己在嘗試修改單位為公尺中

謝謝分享實用的工具；對工作很有幫助。

感謝大大無私提供，急需急需

請問大大要如何下載，怎麼都沒有回應
麻煩大大幫忙

感謝分享 公共工程要計算數量這太好用了 謝謝唷!!

bruce79 寫到:1.新增一個文字文件(.txt),貼上以下內容

代碼:

(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
)

2.在將該文件副檔名改為(.lsp) (檔名:am.lsp)
3.開啟Autocad工具列中的「載入/卸載應用程式」對話方塊或者執行[appload]
4.選擇該文件位置後載入
5.在指令列key入"am"後,選擇你要的線或面方可使用(但不能選擇圖塊喔)
PS:這是一位建築師給我的LISP
ps:好東西與好朋友分享!!

---

蘋果爸補充:
每個CAD版本可能會有些差異，每個人使用方式也要討論及了解，才能知道問題在哪!
是否有開啟一張新圖來做測試，如果可以測試其他電腦的CAD版本。
我這裡使用2023版本操作沒有問題!


謝謝程式分享及說明~< 積分 +1>

[公告]關於團隊成員的回文及貢獻

太棒了

感謝分享

感謝大大無私分享
感謝建築師喔