[分享]計算某某材質的斷面積及重量的AutoLisp
+5
likesela
shinjii
judyyai
机械工程师
CADkawaii
9 posters
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
[分享]計算某某材質的斷面積及重量的AutoLisp
計算某某材質的斷面積及重量的AutoLisp ,這個Lisp以鋼材密度 7.85 來計算,你可以任意修改成你要計算的材質或輸出方式。
- 代碼:
(defun C:AreaCal (/ *error*
olderr OLC OSM OBM ODM oldsnp dimscal olayer hh click en aa MxM MxMtextout pt Prb Txt OTWeight OTWeighttextout
default
Eobj)
(setq olderr *error* )
(setq *error* DectectError)
(setq OLC (getvar "LIMCHECK"))
(setq OSM (getvar "OSMODE"))
(setq OCE (getvar "CMDECHO"))
(setq OBM (getvar "BLIPMODE"))
(setq ODM (getvar "DRAGMODE"))
(setq oldsnp (getvar "snapmode"))
(setq dimscal (getvar "dimscale"))
(setq olayer (getvar "clayer"))
(command "undo" "group")
(setvar "snapmode" 0)
(setvar "CMDECHO" 0)
;;; **********************************
(setq hh (* dimscal 3))
(print "請點選欲計算面積封閉區域中的點")
(setq click (getpoint))
(CreateLayer "remark")
(command "-Hatch" "prop" "solid" click "")
(setq en (entlast))
(changeObjLayer en "remark")
(if(/= en nil)
(progn
(command "Area" "O" en)
;;(redraw en 3)
(setq aa (getvar "area"))
;;米平方計算
(setq MxM (/ aa 1000000.000000))
(setq MxMtextout (rtos MxM 2 15))
(setq pt(getpoint "\n 選取文字位置點: "))
;;***********Text Label***********
(setvar "OSMODE" OSM)
(setq dimscal (getvar "dimscale"))
(setvar "TextSize" (* dimscal 3))
(SETQ Prb (polar pt 0 (* 1.5 60 dimscal)))
(setvar "DIMZIN" 8)
(setq Txt (strcat "面積=" MxMtextout " M平方" ))
(command "-MTEXT" pt "J" "ML" Prb Txt "")
;;(command "text" click hh 0 (strcat "面積=" MxMtextout " M平方" ) "")
;;CM平方計算
(setq CMXCM (/ aa 100.000000))
(setq CMXCMtextout (rtos CMXCM 2 15))
;;***********Text Label***********
(setq pt (polar pt (* 1.5 pi) (* hh 2))) ;; 向下推一行
(setq dimscal (getvar "dimscale"))
(setvar "TextSize" (* dimscal 3))
(SETQ Prb (polar pt 0 (* 1.5 60 dimscal)))
(setvar "DIMZIN" 8)
(setq Txt (strcat "鋼材斷面積=" CMXCMtextout " CM平方" ))
(command "-MTEXT" pt "J" "ML" Prb Txt "")
;;(command "text" click hh 0 (strcat "面積=" CMXCMtextout " CM平方" ) "")
(setq OTWeight (* aa 0.00785)) ;;密度
(setq OTWeighttextout (rtos OTWeight 2 2))
;;***********Text Label***********
(setq pt (polar pt (* 1.5 pi) (* hh 2)));; 向下推一行
(setq dimscal (getvar "dimscale"))
(setvar "TextSize" (* dimscal 3))
(SETQ Prb (polar pt 0 (* 1.5 60 dimscal)))
(setvar "DIMZIN" 8)
(setq Txt (strcat "OT 每米重量=" OTWeighttextout "Kg" ))
(command "-MTEXT" pt "J" "ML" Prb Txt "")
;;***********材料長度***********
(setq OTL (getstring (strcat "請輸入材料總長(注意!!接近規格尺寸請輸入規格尺寸,以利計價 1mm = 0.001 單位M):")))
(setq OTL (Atof OTL))
(setq OTTTWeight (* aa 0.00785 OTL))
(setq OTTTWeighttextout (rtos OTTTWeight 2 2))
;;***********Text Label***********
(setq pt (polar pt (* 1.5 pi) (* hh 2)));; 向下推一行
(setq dimscal (getvar "dimscale"))
(setvar "TextSize" (* dimscal 3))
(SETQ Prb (polar pt 0 (* 1.5 60 dimscal)))
(setvar "DIMZIN" 8)
(setq Txt (strcat "OT " (rtos OTL 2 5) "M 總重量=" OTTTWeighttextout "Kg" ))
(command "-MTEXT" pt "J" "ML" Prb Txt "")
(command "erase" en "")
)
)
(setvar "LIMCHECK" OLC)
(setvar "OSMODE" OSM)
(setvar "CMDECHO" OCE)
(setvar "BLIPMODE" OBM)
(setvar "DRAGMODE" ODM)
(setvar "snapmode" oldsnp)
(setvar "Clayer" olayer)
(setq *error* olderr)
(command "undo" "end")
(prompt "\n =^.^= Max T. =^.^= ")
)
(defun DectectError (s)
(if (/= s "指令取消")
(princ)
(princ (strcat "\nError: " s))
)
(setvar "LIMCHECK" OLC)
(setvar "OSMODE" OSM)
(setvar "CMDECHO" OCE)
(setvar "BLIPMODE" OBM)
(setvar "DRAGMODE" ODM)
(setvar "snapmode" oldsnp)
(setvar "Clayer" olayer)
(setq *error* olderr)
(command "undo" "end")
(setvar "CMDECHO" OCE)
)
;;********************** Create Temp Layer *******************************
(defun CreateLayer (TmpLayer)
(setq SearchResault (tblsearch "layer" TmpLayer))
(if (null SearchResault)
(command "-layer" "n" TmpLayer "")
(command "Clayer" TmpLayer "")
)
)
;;;************************ changeObjLayer *********************************
(defun changeObjLayer (obj Layername)
(command "chprop" obj "" "la" Layername "")
)
Tiger&蘋果爸 在 2010-01-14, 10:46 作了第 3 次修改 (原因 : 修正)
CADkawaii- 中級會員
- 文章總數 : 76
年齡 : 53
來自 : 台北
職業 : 工
愛好 : 刺繡插花
個性 : 溫文儒雅
積分 : 7
經驗值 : 5741
威望值 : 52
發帖精華 : 1
注冊日期 : 2009-05-21
回復: [分享]計算某某材質的斷面積及重量的AutoLisp
初步看了下,很完整的程序,有出错处理,对学习lsp很有帮助的。
机械工程师- 初級會員
- 文章總數 : 35
年齡 : 47
來自 : china
職業 : live
個性 : good
積分 : 1
經驗值 : 5726
威望值 : 3
注冊日期 : 2009-03-26
回復: [分享]計算某某材質的斷面積及重量的AutoLisp
CADkawaii 寫到:計算某某材質的斷面積及重量的AutoLisp ,這個Lisp以鋼材密度 7.85 來計算,你可以任意修改成你要計算的材質或輸出方式。
- Spoiler(用來隱藏帖子內容):
- 代碼:
(defun C:AreaCal ()
;;; ********************
;;; 儲存舊的的錯誤處理
;;; ********************
(setq olderr *error* )
;;; ********************
;;; 寫入設定新的錯誤處理
;;; ********************
(setq *error* DectectError)
;;; ********************
;;; 儲存原系統變數
;;; ********************
(setq OLC (getvar "LIMCHECK"))
(setq OSM (getvar "OSMODE"))
(setq OCE (getvar "CMDECHO"))
(setq OBM (getvar "BLIPMODE"))
(setq ODM (getvar "DRAGMODE"))
(setq oldsnp (getvar "snapmode"))
(setq dimscal (getvar "dimscale"))
(setq olayer (getvar "clayer"))
;;; ********************
(command "undo" "group")
;; 掠過如下 Command 的 Undo 動作
(setvar "OSMODE" 0)
;;; **********************************
(setq hh (* dimscal 3))
(setq click (getpoint))
(CreateLayer "remark")
(command "bpoly" click "")
(setq en (entlast))
(changeObjLayer en "remark")
(if(/= en nil)
(progn
(command "Area" "O" en)
(redraw en 3)
(setq aa (getvar "area"))
;;米平方計算
(setq MxM (/ aa 1000000.000000))
(setq MxMtextout (rtos MxM 2 15))
(setq pt(getpoint "\n 選取文字位置點: "))
;;***********Text Label***********
(setvar "OSMODE" OSM)
(setq dimscal (getvar "dimscale"))
(setvar "TextSize" (* dimscal 3))
(SETQ Prb (polar pt 0 (* 1.5 60 dimscal)))
(setvar "DIMZIN" 8)
(setq Txt (strcat "面積=" MxMtextout " M平方" ))
(command "-MTEXT" pt "J" "ML" Prb Txt "")
;;(command "text" click hh 0 (strcat "面積=" MxMtextout " M平方" ) "")
;;CM平方計算
(setq CMXCM (/ aa 100.000000))
(setq CMXCMtextout (rtos CMXCM 2 15))
;;***********Text Label***********
(setq pt (polar pt (* 1.5 pi) (* hh 2))) ;; 向下推一行
(setq dimscal (getvar "dimscale"))
(setvar "TextSize" (* dimscal 3))
(SETQ Prb (polar pt 0 (* 1.5 60 dimscal)))
(setvar "DIMZIN" 8)
(setq Txt (strcat "鋼材斷面積=" CMXCMtextout " CM平方" ))
(command "-MTEXT" pt "J" "ML" Prb Txt "")
;;(command "text" click hh 0 (strcat "面積=" CMXCMtextout " CM平方" ) "")
(setq OTWeight (* aa 0.00785)) ;;密度
(setq OTWeighttextout (rtos OTWeight 2 2))
;;***********Text Label***********
(setq pt (polar pt (* 1.5 pi) (* hh 2)));; 向下推一行
(setq dimscal (getvar "dimscale"))
(setvar "TextSize" (* dimscal 3))
(SETQ Prb (polar pt 0 (* 1.5 60 dimscal)))
(setvar "DIMZIN" 8)
(setq Txt (strcat "OT 每米重量=" OTWeighttextout "Kg" ))
(command "-MTEXT" pt "J" "ML" Prb Txt "")
;;***********材料長度***********
(setq OTL (getstring (strcat "請輸入材料總長(注意!!接近規格尺寸請輸入規格尺寸,以利計價 1mm = 0.001 單位M):")))
(setq OTL (Atof OTL))
(setq OTTTWeight (* aa 0.00785 OTL))
(setq OTTTWeighttextout (rtos OTTTWeight 2 2))
;;***********Text Label***********
(setq pt (polar pt (* 1.5 pi) (* hh 2)));; 向下推一行
(setq dimscal (getvar "dimscale"))
(setvar "TextSize" (* dimscal 3))
(SETQ Prb (polar pt 0 (* 1.5 60 dimscal)))
(setvar "DIMZIN" 8)
(setq Txt (strcat "OT " (rtos OTL 2 5) "M 總重量=" OTTTWeighttextout "Kg" ))
(command "-MTEXT" pt "J" "ML" Prb Txt "")
)
)
;;)
;;; **********************************
;;; **********************************
;;; 程式順利結束回復系統變數及例外處理
;;; **********************************
(setvar "LIMCHECK" OLC)
(setvar "OSMODE" OSM)
(setvar "CMDECHO" OCE)
(setvar "BLIPMODE" OBM)
(setvar "DRAGMODE" ODM)
(setvar "snapmode" oldsnp)
(setvar "Clayer" olayer)
(setq *error* olderr)
(command "undo" "end")
(prompt "\n ^0^ ^0^ ^0^ ^0^ ^0^ ")
)
;;;********************
;;; 主程式結束
;;;********************
(defun DectectError (s)
;;; ********************
;;; 自定例外處理函示
;;; ********************
(if (/= s "指令取消")
(princ)
(princ (strcat "\nError: " s))
)
(setvar "LIMCHECK" OLC)
(setvar "OSMODE" OSM)
(setvar "CMDECHO" OCE)
(setvar "BLIPMODE" OBM)
(setvar "DRAGMODE" ODM)
(setvar "snapmode" oldsnp)
(setvar "Clayer" olayer)
(setq *error* olderr)
(command "undo" "end")
(setvar "CMDECHO" OCE)
)
;;********************** Create Temp Layer *******************************
(defun CreateLayer (TmpLayer)
(setq SearchResault (tblsearch "layer" TmpLayer))
(if (null SearchResault)
(command "-layer" "n" TmpLayer "")
(command "Clayer" TmpLayer "")
)
)
;;;************************ changeObjLayer *********************************
(defun changeObjLayer (obj Layername)
(command "chprop" obj "" "la" Layername "")
感謝分享!積分 1
請問這是你自己寫的嗎?
若不是最好註明出處!比較妥當!
judyyai- 管理顧問
- 文章總數 : 7786
年齡 : 47
來自 : 台南
職業 : 機械製圖
愛好 : 電腦相關
個性 : think too much...
使用年資 : 10↑
使用版本 : AC2019(開始於2019年底末月)
AutoCAD基礎篇等級 : 10星級
積分 : 393
最佳解答 : 1
經驗值 : 30447
威望值 : 3610
發帖精華 : 2
回帖精華 : 4
注冊日期 : 2008-11-19
回復: [分享]計算某某材質的斷面積及重量的AutoLisp
是阿,我還寫了不銹鋼,鋁材,玻璃等計算
(command "bpoly" click "")
(setq en (entlast))
重點就是用 boundary 指令將產生的 Poly 存起來,再用計算面積指令算面積,這個程式並不困難。
(if(/= en nil)
(progn
(command "Area" "O" en)
(redraw en 3)
(setq aa (getvar "area"))
本來想連續加總做大量計算,我發現會忘記自己點到哪了,不如把材料斷面先清點列表,再來算重量。
密度直接改7.93 可以計算不銹鋼#304 ,改7.98 可以計算 #316
其他材料如 metal sheet 要改一下輸出入方式,鋁材、玻璃則有各種密度。
(command "bpoly" click "")
(setq en (entlast))
重點就是用 boundary 指令將產生的 Poly 存起來,再用計算面積指令算面積,這個程式並不困難。
(if(/= en nil)
(progn
(command "Area" "O" en)
(redraw en 3)
(setq aa (getvar "area"))
本來想連續加總做大量計算,我發現會忘記自己點到哪了,不如把材料斷面先清點列表,再來算重量。
密度直接改7.93 可以計算不銹鋼#304 ,改7.98 可以計算 #316
其他材料如 metal sheet 要改一下輸出入方式,鋁材、玻璃則有各種密度。
CADkawaii- 中級會員
- 文章總數 : 76
年齡 : 53
來自 : 台北
職業 : 工
愛好 : 刺繡插花
個性 : 溫文儒雅
積分 : 7
經驗值 : 5741
威望值 : 52
發帖精華 : 1
注冊日期 : 2009-05-21
回復: [分享]計算某某材質的斷面積及重量的AutoLisp
机械工程师 寫到:初步看了下,很完整的程序,有出错处理,对学习lsp很有帮助的。
http://www.jefferypsanders.com/autolisp.html#NUM
jeffery 有很多完整的範例,我大部分都看他寫的,跟你分享。
CADkawaii- 中級會員
- 文章總數 : 76
年齡 : 53
來自 : 台北
職業 : 工
愛好 : 刺繡插花
個性 : 溫文儒雅
積分 : 7
經驗值 : 5741
威望值 : 52
發帖精華 : 1
注冊日期 : 2009-05-21
回復: [分享]計算某某材質的斷面積及重量的AutoLisp
沒學過這樣的功能
這lisp還真好用耶~!
謝謝大大無私的分享
這lisp還真好用耶~!
謝謝大大無私的分享
shinjii- 中級會員
- 文章總數 : 149
年齡 : 42
來自 : 台北
職業 : 朝全能的工程師邁進
愛好 : 騎鐵馬、爬文
個性 : 用平靜的心看待一切
使用年資 : 還太嫩...
使用版本 : 2008、2010、2012
積分 : 6
經驗值 : 6063
威望值 : 90
注冊日期 : 2009-05-20
回復: [分享]計算某某材質的斷面積及重量的AutoLisp
工作上很須要~謝謝
likesela- 初級會員
- 文章總數 : 16
年齡 : 42
來自 : albadl
職業 : l;jfa;slj
個性 : gl;ajsdf;lkas
積分 : 1
經驗值 : 5682
威望值 : -1
未回應主題 : 1
注冊日期 : 2009-05-15
回復: [分享]計算某某材質的斷面積及重量的AutoLisp
修正一下
(defun C:AreaCal ( / *error*)
忘了宣告 *error* 要第一個宣告變數才有用
(defun C:AreaCal ( / *error*)
忘了宣告 *error* 要第一個宣告變數才有用
CADkawaii- 中級會員
- 文章總數 : 76
年齡 : 53
來自 : 台北
職業 : 工
愛好 : 刺繡插花
個性 : 溫文儒雅
積分 : 7
經驗值 : 5741
威望值 : 52
發帖精華 : 1
注冊日期 : 2009-05-21
回復: [分享]計算某某材質的斷面積及重量的AutoLisp
修正錯誤,改用 Hatch 來計算斷面積,對於中空圖形計算就不會出錯了,還有修改以前錯誤的寫法
- 代碼:
(defun C:AreaCal (/ *error*
olderr OLC OSM OBM ODM oldsnp dimscal olayer hh click en aa MxM MxMtextout pt Prb Txt OTWeight OTWeighttextout
default
Eobj)
(setq olderr *error* )
(setq *error* DectectError)
(setq OLC (getvar "LIMCHECK"))
(setq OSM (getvar "OSMODE"))
(setq OCE (getvar "CMDECHO"))
(setq OBM (getvar "BLIPMODE"))
(setq ODM (getvar "DRAGMODE"))
(setq oldsnp (getvar "snapmode"))
(setq dimscal (getvar "dimscale"))
(setq olayer (getvar "clayer"))
(command "undo" "group")
(setvar "snapmode" 0)
(setvar "CMDECHO" 0)
;;; **********************************
(setq hh (* dimscal 3))
(print "請點選欲計算面積封閉區域中的點")
(setq click (getpoint))
(CreateLayer "remark")
(command "-Hatch" "prop" "solid" click "")
(setq en (entlast))
(changeObjLayer en "remark")
(if (= (cdr (assoc 0 (entget en))) "HATCH")
(progn
(command "Area" "O" en)
;;(redraw en 3)
(setq aa (getvar "area"))
;;米平方計算
(setq MxM (/ aa 1000000.000000))
(setq MxMtextout (rtos MxM 2 15))
(setq pt(getpoint "\n 選取文字位置點: "))
;;***********Text Label***********
(setvar "OSMODE" OSM)
(setq dimscal (getvar "dimscale"))
(setvar "TextSize" (* dimscal 3))
(SETQ Prb (polar pt 0 (* 1.5 60 dimscal)))
(setvar "DIMZIN" 8)
(setq Txt (strcat "面積=" MxMtextout " M平方" ))
(command "-MTEXT" pt "J" "ML" Prb Txt "")
;;(command "text" click hh 0 (strcat "面積=" MxMtextout " M平方" ) "")
;;CM平方計算
(setq CMXCM (/ aa 100.000000))
(setq CMXCMtextout (rtos CMXCM 2 15))
;;***********Text Label***********
(setq pt (polar pt (* 1.5 pi) (* hh 2))) ;; 向下推一行
(setq dimscal (getvar "dimscale"))
(setvar "TextSize" (* dimscal 3))
(SETQ Prb (polar pt 0 (* 1.5 60 dimscal)))
(setvar "DIMZIN" 8)
(setq Txt (strcat "鋼材斷面積=" CMXCMtextout " CM平方" ))
(command "-MTEXT" pt "J" "ML" Prb Txt "")
;;(command "text" click hh 0 (strcat "面積=" CMXCMtextout " CM平方" ) "")
(setq OTWeight (* aa 0.00785)) ;;密度
(setq OTWeighttextout (rtos OTWeight 2 2))
;;***********Text Label***********
(setq pt (polar pt (* 1.5 pi) (* hh 2)));; 向下推一行
(setq dimscal (getvar "dimscale"))
(setvar "TextSize" (* dimscal 3))
(SETQ Prb (polar pt 0 (* 1.5 60 dimscal)))
(setvar "DIMZIN" 8)
(setq Txt (strcat "OT 每米重量=" OTWeighttextout "Kg" ))
(command "-MTEXT" pt "J" "ML" Prb Txt "")
;;***********材料長度***********
(setq OTL (getstring (strcat "請輸入材料總長(注意!!接近規格尺寸請輸入規格尺寸,以利計價 1mm = 0.001 單位M):")))
(setq OTL (Atof OTL))
(setq OTTTWeight (* aa 0.00785 OTL))
(setq OTTTWeighttextout (rtos OTTTWeight 2 2))
;;***********Text Label***********
(setq pt (polar pt (* 1.5 pi) (* hh 2)));; 向下推一行
(setq dimscal (getvar "dimscale"))
(setvar "TextSize" (* dimscal 3))
(SETQ Prb (polar pt 0 (* 1.5 60 dimscal)))
(setvar "DIMZIN" 8)
(setq Txt (strcat "OT " (rtos OTL 2 5) "M 總重量=" OTTTWeighttextout "Kg" ))
(command "-MTEXT" pt "J" "ML" Prb Txt "")
(command "erase" en "")
)
(print "點選錯誤")
)
(setvar "LIMCHECK" OLC)
(setvar "OSMODE" OSM)
(setvar "CMDECHO" OCE)
(setvar "BLIPMODE" OBM)
(setvar "DRAGMODE" ODM)
(setvar "snapmode" oldsnp)
(setvar "Clayer" olayer)
(setq *error* olderr)
(command "undo" "end")
(prompt "\n =^.^= Max T. =^.^= ")
)
(defun DectectError (s)
(if (/= s "指令取消")
(princ)
(princ (strcat "\nError: " s))
)
(setvar "LIMCHECK" OLC)
(setvar "OSMODE" OSM)
(setvar "CMDECHO" OCE)
(setvar "BLIPMODE" OBM)
(setvar "DRAGMODE" ODM)
(setvar "snapmode" oldsnp)
(setvar "Clayer" olayer)
(setq *error* olderr)
(command "undo" "end")
(setvar "CMDECHO" OCE)
)
;;********************** Create Temp Layer *******************************
(defun CreateLayer (TmpLayer)
(setq SearchResault (tblsearch "layer" TmpLayer))
(if (null SearchResault)
(command "-layer" "n" TmpLayer "")
(command "Clayer" TmpLayer "")
)
)
;;;************************ changeObjLayer *********************************
(defun changeObjLayer (obj Layername)
(command "chprop" obj "" "la" Layername "")
)
CADkawaii- 中級會員
- 文章總數 : 76
年齡 : 53
來自 : 台北
職業 : 工
愛好 : 刺繡插花
個性 : 溫文儒雅
積分 : 7
經驗值 : 5741
威望值 : 52
發帖精華 : 1
注冊日期 : 2009-05-21
Tiger&蘋果爸 likes this post
回復: [分享]計算某某材質的斷面積及重量的AutoLisp
真的很好用
最近對LSP非常有興趣XD
最近對LSP非常有興趣XD
DIGE- 初級會員
- 文章總數 : 42
年齡 : 38
來自 : 台中市
職業 : 繪圖員
愛好 : 看書
個性 : 正常
使用年資 : 8
使用版本 : 2010
積分 : 1
經驗值 : 5728
威望值 : 11
注冊日期 : 2009-07-11
回復: [分享]計算某某材質的斷面積及重量的AutoLisp
可以參考以下二種方式將它自動掛入!米虫 寫到:請問這lsp 可直接放cad中 就可執行嗎 還是每一次都要load進去
[教學]載入LISP應用程式 APPLOAD指令
https://www.autocad-tw.com/t111-topic
[影片]自訂CUI 載入LISP
https://www.autocad-tw.com/t3999-topic
Tiger&蘋果爸 在 2022-04-18, 17:21 作了第 1 次修改
____________________________________________________________________________________
👉快速比例設定與出圖技巧-線上課程(點我)👈
aaaaaa1111- 一般會員
- 文章總數 : 142
年齡 : 48
來自 : 台中
職業 : 行政
愛好 : 繪圖
個性 : 中性
使用年資 : 15年
使用版本 : 2008
經驗值 : 5871
威望值 : 0
注冊日期 : 2009-11-30
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
這個論壇的權限:
您 無法 在這個版面回復文章