CAD中自動求和與自動求面積的解決方案

1、AutoCAD中數(shù)值自動求和與多段線自動計算面積和及長度和的解決方案 Isp ”，保存在數(shù)值的自動求和解決 將下方陰影區(qū)程序復(fù)制，另建文本文檔，打開粘貼后另存為“數(shù)值求和常用軟件備份目錄下。在CAD啟動完成后在命令行輸入“ ap ”命令，在彈出的“加載/卸載應(yīng)用程序”對話框中，查找存放的“數(shù)值求和.Isp ”并點擊“加載”，并可在啟動組中填加該Isp文件。加載成功后，需要求和時，在命令行輸入“sum”命令，然后選擇需求和的數(shù)值，回車確認(rèn)后即可在命令行見到求和結(jié)果。程序(陰影區(qū)全部復(fù)制)；=Sum function=Defun C:Sum( / cmdmode sset ssl n sset t

2、emp ssll total)(if *error* quit) ;Exit CAD whe n error exists(setq cmdmode (getvar cmdecho) ;store the content of cmdecho in variable cmdmode(setvar cmdecho 0);(prompt nSelect nu mbers :)(setq sset (ssget)(if (n ull sset)(progn(pri nc n Error: Noth ing selected!n)(pri nc)(progn(setq ssl (ssle ngth s

3、set) ; retur n the len gth of sset(setq n sset (ssadd) ; con struct a new n ull select ions set(while ( ssl 0)(setq temp (ss name sset (setq ssl(1- ssl);assig n the ss1th member n ame of sset to temp(if (= (cdr (assoc 0 (e ntget temp) TEXT)(ssadd temp n sset) ; add temp to n sset)(setq ssl (ssle ngt

4、h n sset)(pri nt ssl)(pri nc text en tities are foun d.)(setq total 0)(setq ssl1 ssl)(while ( ssl 0)(setq temp (ss name n sset (setq ssl (1- ssl)(setq nu mber (atof(cdr(assoc 1 (en tget temp)(if (= 0 nu mber)(setq ssl1 (1- ssl1)(setq total (+ total nu mber)(princ nThe Sum of the )(pri nc ssl1)(pri n

5、c nu mbers selected is )二、面積自動求和及多段線長度求和將下方陰影區(qū)程序復(fù)制，另建文本文檔，打開粘貼后另存為“面積求和sp ”保存在常用軟件備份目錄下。在 CAD啟動完成后在命令行輸入“ ap”命令，在彈出的“加載/卸載 應(yīng)用程序”對話框中，查找存放的“面積求和.lsp ”并點擊“加載”，并可在啟動組中填加該lsp文件。加載成功后，需要求和時，在命令行輸入“am”命令，然后選擇需求和的多段線，回車確認(rèn)后即可在命令行見到求和結(jié)果。程序（陰影區(qū)全部復(fù)制）(pri nc total)(setq cmdecho cmdmode)(pri nc)(defu n C:am (/ s

6、s l i totalarea en ame obj en tarea)(if (setq ss (ssget)(prog n(vl-load-com)(setqmodelspace (vla-get-Modelspace(vla-get-activeDocume nt(vlax-get-acad-object)(setq l (ssle ngth ss) i 0 totalarea 0 totle ngth 0)(repeat l(setq en ame (ss name ss i)(setq obj (vlax-e name-vla-object en ame);(vlax-dump-ob

7、ject obj T)(if (vlax-property-available-p obj area)(setq totalarea (+ (vlax-get-property obj area) totalarea)(if (= (cdr (assoc 0 (e ntget en ame) MLINE)(setq totle ngth (+ totle ngth (ml-le ngth en ame)(setqtotle ngth(+totle ngth(vlax-curve-getdistatparamen ame(vlax-curve-gete ndparam en ame)(setq

8、i (1+ i)text2 (strcat 總長度為：(rtos totlength 2 4)毫米”)(if (setq in sertpt (getpoi nt n請輸入文字插入點：)(if (setq height (getdist n請輸入文字高度:)(setq in sertp1 (vlax-3d-po int in sertpt)in sertp2 (vlax-3d-poi nt (polar in sertpt (* Pi) (* height)textobj1 (vla-addtext modelspace text1 in sertp1 height)textobj2 (vla-addtext modelspace text2 in sertp2 height)(defu n ml-le ngth (en ame / j d ptlist)(foreach n (en tget en ame)(if (= (car n) 11)(setq ptlist (c ons (cdr n) ptlist)(reve