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

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

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

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

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

發表 由 bruce79 于 2009-10-26, 12: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, 07:59 作了第 5 次修改 (原因 : 加分囉~)

bruce79
初級會員
初級會員

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

回頂端 向下


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

發表 由 以西杰 于 2010-08-19, 05:30

因該很有用..收下來拉...

以西杰
初級會員
初級會員

文章總數 : 106
年齡 : 38
來自 : 台中市
職業 : 電腦繪圖員(電機、空調)
愛好 : 宅男
個性 : 懶散
使用年資 : 14年
使用版本 : 2010
積分 : 2
經驗值 : 3701
威望值 : 46
注冊日期 : 2008-05-13
經典問與答讀者 男 天蝎座 馬

回頂端 向下

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

發表 由 以西杰 于 2010-08-19, 05:47

執行後掛掉
跑出下面的指令 我用的是 CAD2010

指令: am
選取物件: 找到 1 個

選取物件:

請輸入文字插入點:
請輸入文字高度:50
# VLA-OBJECT IAcadText 16f961e4

以西杰
初級會員
初級會員

文章總數 : 106
年齡 : 38
來自 : 台中市
職業 : 電腦繪圖員(電機、空調)
愛好 : 宅男
個性 : 懶散
使用年資 : 14年
使用版本 : 2010
積分 : 2
經驗值 : 3701
威望值 : 46
注冊日期 : 2008-05-13
經典問與答讀者 男 天蝎座 馬

回頂端 向下

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

發表 由 andychen 于 2010-09-28, 10:37

感覺應該蠻實用的
來研究看看
感謝分享~~

andychen
該用戶停權中
該用戶停權中

文章總數 : 187
年齡 : 33
經驗值 : 3451
威望值 : 71
注冊日期 : 2010-04-09
男 水瓶座 豬

回頂端 向下

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

發表 由 adslwang 于 2010-10-16, 00:02

謝謝bruce79分享

使用後很方便,比我現有的方便很多,可以省去切換動作,謝謝
傻笑


adslwang 在 2010-10-16, 00:58 作了第 1 次修改 (原因 : 使用後感言)
avatar
adslwang
高級會員
高級會員

文章總數 : 372
年齡 : 39
來自 : 台南
職業 : 自由業
愛好 : 電腦、旅行
個性 : 樂觀
使用年資 : 1年
使用版本 : 2009
積分 : 17
經驗值 : 4605
威望值 : 355
回帖精華 : 1
注冊日期 : 2008-10-02
藍鵲88號
男 處女座 馬

回頂端 向下

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

發表 由 長陳 于 2010-10-25, 16:39

最近工作有需要用到~~
感謝分享
avatar
長陳
新手上路
新手上路

文章總數 : 8
年齡 : 48
來自 : 高雄
職業 : 工程
愛好 : cad
個性 : ok
使用年資 : 2
使用版本 : 2008
經驗值 : 2581
威望值 : 0
注冊日期 : 2010-10-23
男 雙魚座 雞

回頂端 向下

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

發表 由 sea0702 于 2010-11-01, 01:57

找這個lisp很久了~本來想說自己來試試看說
算面積真是太方便了~感謝分享
avatar
sea0702
初級會員
初級會員

文章總數 : 26
年齡 : 35
來自 : 基隆
職業 : 工程師
愛好 : 電影
個性 : 開朗
使用年資 : 5
使用版本 : 2010
積分 : 2
經驗值 : 3211
威望值 : 21
注冊日期 : 2009-04-04
男 巨蟹座 狗

回頂端 向下

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

發表 由 sandsand 于 2010-11-06, 14:29

好像很不錯,正好工作也需要算面積,謝謝喔
avatar
sandsand
初級會員
初級會員

文章總數 : 11
年齡 : 37
來自 : 彰化
職業 : 石材建築
愛好 : 學習新的事物
個性 : 認真
使用年資 : 7年
使用版本 : 2008
積分 : 1
經驗值 : 2590
威望值 : 0
注冊日期 : 2010-10-25
串連貼紙成功 女 白羊座 猴

回頂端 向下

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

發表 由 opk153 于 2010-11-06, 15:34

我個人是沒有使用到...不過女朋友是做室內設計的..就弄給他用看看囉...感謝分享~
avatar
opk153
初級會員
初級會員

文章總數 : 29
年齡 : 37
來自 : 鶯歌區
職業 : 品管
愛好 : 籃球、壘球
個性 : 溫和..大多時不愛說話
使用年資 : 2
使用版本 : 2010
積分 : 1
經驗值 : 2678
威望值 : 18
注冊日期 : 2010-10-15
男 雙魚座 猴

回頂端 向下

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

發表 由 jhou0219 于 2011-03-14, 15:36

感謝分享 這樣可以不用aa再一個一個點
avatar
jhou0219
初級會員
初級會員

文章總數 : 20
年齡 : 30
來自 : 台北
職業 : 設計師助理
愛好 : PC
個性 : OPEN
使用年資 : 1
使用版本 : 2010
積分 : 1
經驗值 : 2533
威望值 : 0
注冊日期 : 2011-01-21
串連貼紙成功 男 雙魚座 兔

回頂端 向下

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

發表 由 arhome 于 2011-03-24, 09:07

報名使用,謝謝分享
avatar
arhome
初級會員
初級會員

文章總數 : 19
年齡 : 39
來自 : taichung
職業 : 我什麼都不會…我是畫圖的
愛好 :
個性 :
使用年資 : 6
使用版本 : 2009
積分 : 1
經驗值 : 2970
威望值 : 5
注冊日期 : 2009-10-29
男 射手座 蛇

回頂端 向下

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

發表 由 lok 于 2011-04-08, 05:53

很面積計算,謝謝了..
avatar
lok
一般會員
一般會員

文章總數 : 17
年齡 : 42
來自 : 台北市
職業 : 機械工程
愛好 : cad繪圖
個性 : 內向
使用年資 : 剛接觸
使用版本 : 2011
經驗值 : 2767
威望值 : 0
注冊日期 : 2010-05-21
男 雙子座 兔

回頂端 向下

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

發表 由 小香 于 2011-04-25, 19:32

我也要試試看,謝謝分享
avatar
小香
初級會員
初級會員

文章總數 : 32
年齡 : 43
來自 : 台中市
職業 : 繪圖員
愛好 : 畫圖
個性 :
使用年資 : 1年
使用版本 : 2008
積分 : 1
經驗值 : 2707
威望值 : 12
注冊日期 : 2010-10-12
串連貼紙成功 女 天秤座 虎

回頂端 向下

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

發表 由 老水牛 于 2011-06-03, 08:44

多謝你的分享~~~~~感恩

老水牛
初級會員
初級會員

文章總數 : 105
年齡 : 55
來自 : 台北縣
職業 : 電機
愛好 : 閱讀
個性 : 溫和
使用年資 : 6
使用版本 : 2006
積分 : 1
經驗值 : 3529
威望值 : 3
注冊日期 : 2008-10-17
男 天蝎座 牛

回頂端 向下

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

發表 由 ysl yang 于 2011-06-17, 08:29

工作上常要計算面積及長度~
好感動~
謝謝無私分享~
感動
avatar
ysl yang
初級會員
初級會員

文章總數 : 118
年齡 : 49
來自 : 台北市
職業 : 繪圖員
愛好 : 逛大賣場
個性 : 隨和中等
使用年資 : 10年以上
使用版本 : 2010剛用
積分 : 1
經驗值 : 3058
威望值 : 123
注冊日期 : 2010-11-02
女 獅子座 猴

回頂端 向下

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

發表 由 GRACE0724 于 2011-07-13, 07:52

謝謝板主與蘋果爸.judy
來看看囉~
avatar
GRACE0724
初級會員
初級會員

文章總數 : 170
年齡 : 48
來自 : 桃園市荒郊野外
職業 : 櫻櫻美代子股份無限公司總裁
愛好 : 看書.踏青.最好是睡到自然醒^_^
個性 : 外向.真的外向
使用年資 : 新手初學
使用版本 : 2010
積分 : 6
經驗值 : 2917
威望值 : 124
注冊日期 : 2011-05-23
經典問與答讀者 藍鵲20號
2011聚會勳章 串連貼紙成功 女 獅子座 雞

http://tw.myblog.yahoo.com/jw!GLIrG1KcHwGdnXuRx9WA8mM-

回頂端 向下

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

發表 由 jerry775 于 2011-08-23, 16:53

還沒用過lisp,找時間學學該怎麼使用才是
看看先哦,謝謝分享~~
avatar
jerry775
初級會員
初級會員

文章總數 : 23
年齡 : 51
來自 : 南投縣
職業 : 畜牧兼室內設計
愛好 : 很多
個性 : 隨和,善良
使用年資 : 1年
使用版本 : 2009
積分 : 2
經驗值 : 2502
威望值 : 22
注冊日期 : 2011-03-08
2D基礎函授 經典問與答讀者 藍鵲115號
男 金牛座 馬

回頂端 向下

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

發表 由 lingo_st 于 2012-08-28, 13:37

個人覺得本論壇提供的資源比較令人喜愛且放心
原因
1.再如何無厘頭得問題都有人回覆
2.後續服務是無限次數
3.不止給你魚吃還教你釣魚
好處
1.免費
2.還是免費
3.再問我扁你!!!都告訴你是免費了
avatar
lingo_st
中級會員
中級會員

文章總數 : 211
年齡 : 53
來自 : 新北市
職業 : 營造,建設
愛好 : 學習,服務,電腦軟硬體
個性 : 正直,達觀且無可救藥的雞婆
使用年資 : 使用12年但真的是新手
使用版本 : 2012,2013
積分 : 6
經驗值 : 3378
威望值 : 271
注冊日期 : 2011-12-18
經典問與答讀者 藍鵲238號
男 雙魚座 龍

回頂端 向下

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

發表 由 Tiger&蘋果爸 于 2012-08-29, 02:21

lingo_st 寫到:個人覺得本論壇提供的資源比較令人喜愛且放心
原因
1.再如何無厘頭得問題都有人回覆
2.後續服務是無限次數
3.不止給你魚吃還教你釣魚
好處
1.免費
2.還是免費
3.再問我扁你!!!都告訴你是免費了
哈哈...這是見證互助的力量!
大家一起來分享吧~
害羞

____________________________________________________________________________________
avatar
Tiger&蘋果爸
系統管理員
系統管理員

文章總數 : 17203
年齡 : 41
來自 : 台北市文山區
職業 : AutoCAD顧問
愛好 : 蹓狗/戶外活動/拍照
個性 : 幽默/樂觀/善良
使用年資 : 15↑
使用版本 : AutoCAD 2016
經驗值 : 64671
威望值 : 12766
注冊日期 : 2008-04-23
2D基礎函授 2D進階函授 3D基礎函授 https://i11.servimg.com/u/f11/19/71/67/71/2d3d10.png2D+3D線上 顧問外掛程式 經典問與答讀者 藍鵲1號
2009聚會勳章 2010聚會勳章 2011聚會勳章 2012聚會勳章 2013勳章-2D基礎 2014聚會勳章 2015聚會勳章 2016聚會勳章 串連貼紙成功 男 水瓶座 兔

http://mypaper.pchome.com.tw/kv1012tiger

回頂端 向下

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

發表 由 et1029et 于 2014-12-19, 08:47

感謝大大的分享,加入收藏~
avatar
et1029et
初級會員
初級會員

文章總數 : 356
年齡 : 36
來自 : 桃園
職業 : 行政繪圖
愛好 : 學習
個性 : 隨和
使用年資 : 新手初學
使用版本 : 2013
積分 : 4
經驗值 : 3322
威望值 : 324
注冊日期 : 2013-07-02
藍鵲666號
女 天蝎座 猴

回頂端 向下

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

發表 由 poiuyy 于 2017-03-21, 05:47

感謝大大的分享
這是個好程式
avatar
poiuyy
初級會員
初級會員

文章總數 : 170
年齡 : 43
來自 : 台中
職業 : 小監
愛好 : 電影
個性 : 中庸
使用年資 : 5
使用版本 : 2010
積分 : 1
經驗值 : 1943
威望值 : 78
注冊日期 : 2014-06-24
藍鵲656號
男 天秤座 虎

回頂端 向下

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

發表 由 poiuyy 于 2017-03-21, 06:33

選取物件: 找到 1 個
選取物件:
忽略 1 個既不是 AME 實體也不是面域的物件。


請問是哪裡有問題??

謝謝

--------------------------------------
(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
)
avatar
poiuyy
初級會員
初級會員

文章總數 : 170
年齡 : 43
來自 : 台中
職業 : 小監
愛好 : 電影
個性 : 中庸
使用年資 : 5
使用版本 : 2010
積分 : 1
經驗值 : 1943
威望值 : 78
注冊日期 : 2014-06-24
藍鵲656號
男 天秤座 虎

回頂端 向下

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

發表 由 poiuyy 于 2017-03-21, 06:39

指令: _appload am.lsp 成功載入。
指令: ; 錯誤: 語法錯誤

請問哪裡錯誤??

謝謝
avatar
poiuyy
初級會員
初級會員

文章總數 : 170
年齡 : 43
來自 : 台中
職業 : 小監
愛好 : 電影
個性 : 中庸
使用年資 : 5
使用版本 : 2010
積分 : 1
經驗值 : 1943
威望值 : 78
注冊日期 : 2014-06-24
藍鵲656號
男 天秤座 虎

回頂端 向下

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

發表 由 nicky1273 于 2017-10-08, 02:49

感謝分享,謝謝你大人
讚趕快來下載
avatar
nicky1273
新手上路
新手上路

文章總數 : 3
年齡 : 32
來自 : taipei
職業 : 繪圖
愛好 : 聽音樂
個性 : 活潑
使用年資 : 10年
使用版本 : 2014
經驗值 : 30
威望值 : 0
注冊日期 : 2017-10-02
男 摩羯座 鼠

回頂端 向下

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

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


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