AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~
AutoCAD顧問
Would you like to react to this message? Create an account in a few clicks or log in to continue.
[分享]聚合線面積加總LISP Io15010 [分享]聚合線面積加總LISP 2020-310 [分享]聚合線面積加總LISP Oiu15010 [分享]聚合線面積加總LISP 2020-211 [分享]聚合線面積加總LISP Oo-2-110 [分享]聚合線面積加總LISP BPl3tjj

[分享]聚合線面積加總LISP

向下

[分享]聚合線面積加總LISP Empty [分享]聚合線面積加總LISP

發表 由 devinchou 于 2020-09-20, 15:09

如標題
這小軟體是針對選取範圍內的聚合線
做面積加總的動作
適用建築抓室內面積
結構抓樑版柱面積
以下為程式碼
代碼:
 ; [CAL] COUNT THE AREA OF LWPOLYLINE(SELECTION SET:).
 ; [計算] 聚合線面積加總(選集內聚合線)。
 ; 支援軟體版本("AutoCAD")
 ; 設計者:Devin,Chou
 ; 版權所有,歡迎使用
 ; Rev.1(2020/09/20)
(defun C:as (/ pl_i s_pa
               pl_s pl_n v_pl v_pl_a
               v_pl_ns v_pl_ne v_pl_ps v_pl_pm
               ps_x ps_y pe_x pe_y pc_x pc_y
               t_lay str1 str2 t_p1 t_p2 )
(vl-load-com)
(setvar "cmdecho" 0 )
(setq t_lay
    (tblsearch "LAYER" "TEMP" ))
(if (= t_lay nil )
    (progn
    (setq t_lay "TEMP" )
    (entmake
    (list
    '(0 . "LAYER" )
    '(100 . "AcDbSymbolTableRecord" )
    '(100 . "AcDbLayerTableRecord" )
    '(62 . 7 )
    '(70 . 0 )
    '(6 . "Continuous" )
     (cons 2 t_lay ))))
    (setq t_lay "TEMP" ))
(setq pl_i 0 s_pa 0 )
(princ "\n請選取聚合線[面積加總]:" )
(setq pl_s
    (ssget '((0 . "LWPOLYLINE" ))))
(setq t_p2
    (getpoint "\n請指定插入點座標[總面積]:" ))
(repeat (sslength pl_s )
(setq pl_n
    (ssname pl_s pl_i ))
(setq v_pl
    (vlax-ename->vla-object pl_n ))
(setq v_pl_a
    (rtos
    (vlax-curve-getArea v_pl ) 2 2 ))
(setq v_pl_ps
    (vlax-curve-getStartPoint v_pl ))
(setq v_pl_ns
    (vlax-curve-getStartParam v_pl ))
(setq v_pl_ne
    (vlax-curve-getEndParam v_pl ))
(setq v_pl_pm
    (vlax-curve-getPointAtParam v_pl
    (/ (- v_pl_ne v_pl_ns ) 2 )))
(setq ps_x (car v_pl_ps ))
(setq ps_y (cadr v_pl_ps ))
(setq pe_x (car v_pl_pm ))
(setq pe_y (cadr v_pl_pm ))
(setq pc_x
    (/ (+ ps_x pe_x ) 2 ))
(setq pc_y
    (/ (+ ps_y pe_y ) 2 ))
(setq t_p1
    (list pc_x pc_y 0 ))
(setq str1
    (strcat "面積:" v_pl_a "cm2" ))
(entmake
    (list
    '(0 . "TEXT" )
     (cons 1 str1 )
     (cons 10 t_p1 )
     (cons 40 20 )
     (cons 41 0.8 )
     (cons 72 1 )
     (cons 11 t_p1 )
     (cons 8 t_lay )))
(setq s_pa
    (+ s_pa (atof v_pl_a )))
(setq pl_i
    (1+ pl_i ))
(vlax-release-object v_pl )
)
(setq str2
    (strcat "總面積:" (rtos s_pa 2 2 ) "cm2" ))
(entmake
    (list
    '(0 . "TEXT" )
     (cons 1 str2 )
     (cons 10 t_p2 )
     (cons 40 20 )
     (cons 41 0.8 )
     (cons 8 t_lay )))
(prin1)
)
(princ "\nC:as")
(prin1)
附件
[分享]聚合線面積加總LISP Attachment
62. 面積加總_聚 AS.zip 您無權下載這里的附件。(2 Kb) 下載 3 次
devinchou
devinchou
初級會員
初級會員

文章總數 : 55
年齡 : 43
來自 : 基隆
職業 : 鋼筋檢料
愛好 : 寫作.閱讀.烹飪
個性 : 懶小孩一枚
使用年資 : 每天
使用版本 : 2006.2008
積分 : 3
經驗值 : 2608
威望值 : 174
注冊日期 : 2015-02-15
男 天蝎座 蛇

回頂端 向下

[分享]聚合線面積加總LISP Empty 回復: [分享]聚合線面積加總LISP

發表 由 Tiger&蘋果爸 于 2020-09-20, 19:05

灰熊好
!!謝謝無私分享程式~
偷笑

____________________________________________________________________________________
[分享]聚合線面積加總LISP Oo-2-110 [分享]聚合線面積加總LISP Ia15010 [分享]聚合線面積加總LISP Ziao1510 [分享]聚合線面積加總LISP BPl3tjj
Tiger&蘋果爸
Tiger&蘋果爸
系統管理員
系統管理員

文章總數 : 19444
年齡 : 44
來自 : 台北市文山區
職業 : AutoCAD顧問
愛好 : 蹓狗/戶外活動/拍照
個性 : 幽默/樂觀/善良
使用年資 : 20↑
使用版本 : AutoCAD 2021
經驗值 : 77219
威望值 : 14792
注冊日期 : 2008-04-23
2D基礎函授 2D進階函授 3D基礎函授 https://i.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 Uos15010 [分享]聚合線面積加總LISP BPl3tjj [分享]聚合線面積加總LISP Ziao1510 [分享]聚合線面積加總LISP Oo-2-110 [分享]聚合線面積加總LISP Oooo-110 [分享]聚合線面積加總LISP 2020-211