AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~
[分享]一個能顯示面積及長度的LISP程式 - 頁 3 Oooo-110 [分享]一個能顯示面積及長度的LISP程式 - 頁 3 Oo-2-110 [分享]一個能顯示面積及長度的LISP程式 - 頁 3 Ia15010 [分享]一個能顯示面積及長度的LISP程式 - 頁 3 Ziao1510 [分享]一個能顯示面積及長度的LISP程式 - 頁 3 BPl3tjj [分享]一個能顯示面積及長度的LISP程式 - 頁 3 Uos15010 [分享]一個能顯示面積及長度的LISP程式 - 頁 3 Uos15011

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

3頁(共3頁) 上一頁  1, 2, 3

向下

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

發表 由 bruce79 于 2009-10-26, 20:54

主題回顧 :

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:好東西與好朋友分享!!


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

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


Tiger&蘋果爸 在 2011-07-13, 14:59 作了第 5 次修改 (原因 : 加分囉~)
avatar
bruce79
初級會員
初級會員

文章總數 : 169
年齡 : 40
來自 : 南投
職業 : 工程師
愛好 : 運動
個性 : O型-樂觀
使用年資 : 5年
使用版本 : 2008
積分 : 3
經驗值 : 4444
威望值 : 39
未回應主題 : 1
注冊日期 : 2008-09-12
顧問外掛程式 男 巨蟹座 羊

回頂端 向下


[分享]一個能顯示面積及長度的LISP程式 - 頁 3 Empty 回復: [分享]一個能顯示面積及長度的LISP程式

發表 由 老紅 于 2018-05-23, 11:48

感謝分享!太實用了
老紅
老紅
一般會員
一般會員

文章總數 : 11
年齡 : 28
來自 : 新竹
職業 : 繪圖助理
愛好 : 看小說
個性 : 害羞內向
使用年資 : 1
使用版本 : 2012
經驗值 : 522
威望值 : 6
注冊日期 : 2018-05-14
男 巨蟹座 羊

回頂端 向下

[分享]一個能顯示面積及長度的LISP程式 - 頁 3 Empty 回復: [分享]一個能顯示面積及長度的LISP程式

發表 由 tyhaola 于 2019-03-21, 14:02

害羞 害羞 害羞 來試試
tyhaola
tyhaola
一般會員
一般會員

文章總數 : 4
年齡 : 32
來自 : 新竹
職業 : 建築
愛好 : 建築
個性 : 建築
使用年資 : 5
使用版本 : 2017
經驗值 : 397
威望值 : 6
注冊日期 : 2018-08-16
男 天蝎座 虎

回頂端 向下

[分享]一個能顯示面積及長度的LISP程式 - 頁 3 Empty 回復: [分享]一個能顯示面積及長度的LISP程式

發表 由 月蜻蜓 于 2019-05-24, 14:18

感謝分享!! 微笑
月蜻蜓
月蜻蜓
初級會員
初級會員

文章總數 : 47
年齡 : 48
來自 : 新竹
職業 : CAD (2D)
愛好 : 看漫畫,看科幻電影!
個性 : 溫和!
使用年資 : 20
使用版本 : AutoCADM 2013
積分 : 2
經驗值 : 3530
威望值 : 103
注冊日期 : 2010-10-16
經典問與答讀者 藍鵲552號
男 射手座 狗

回頂端 向下

3頁(共3頁) 上一頁  1, 2, 3

回頂端


 
這個論壇的權限:
無法 在這個版面回復文章
[分享]一個能顯示面積及長度的LISP程式 - 頁 3 Uos15011 [分享]一個能顯示面積及長度的LISP程式 - 頁 3 Uos15010 [分享]一個能顯示面積及長度的LISP程式 - 頁 3 BPl3tjj [分享]一個能顯示面積及長度的LISP程式 - 頁 3 Ziao1510 [分享]一個能顯示面積及長度的LISP程式 - 頁 3 Ia15010 [分享]一個能顯示面積及長度的LISP程式 - 頁 3 Oo-2-110 [分享]一個能顯示面積及長度的LISP程式 - 頁 3 Oooo-110