CAD中自动求和与自动求面积的解决方案

1、AutoCAD中数值自动求和与多段线自动计算面积和及长度和的解决方案 Isp ”，保存在数值的自动求和解决 将下方阴影区程序复制，另建文本文档，打开粘贴后另存为“数值求和常用软件备份目录下。在CAD启动完成后在命令行输入“ ap ”命令，在弹出的“加载/卸载应用程序”对话框中，查找存放的“数值求和.Isp ”并点击“加载”，并可在启动组中填加该Isp文件。加载成功后，需要求和时，在命令行输入“sum”命令，然后选择需求和的数值，回车确认后即可在命令行见到求和结果。程序(阴影区全部复制)；=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 )二、面积自动求和及多段线长度求和将下方阴影区程序复制，另建文本文档，打开粘贴后另存为“面积求和sp ”保存在常用软件备份目录下。在 CAD启动完成后在命令行输入“ ap”命令，在弹出的“加载/卸载 应用程序”对话框中，查找存放的“面积求和.lsp ”并点击“加载”，并可在启动组中填加该lsp文件。加载成功后，需要求和时，在命令行输入“am”命令，然后选择需求和的多段线，回车确认后即可在命令行见到求和结果。程序（阴影区全部复制）(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