CAD统计多条线段长度程序及程序加载方法.docxVIP

用下面的这个程序可以，加载后执行命令：mulen (defun c:mulen() (setq i 1 s 0) (prompt 选择直线：) (setq ss (ssget)) (setq leng (sslength ss)) (setq namelist (list(ssname ss 0))) (repeat (1- leng) (setq namelist (append namelist (list (ssname ss i)))) (setq i (1+ i))) (foreach name namelist (setq nameall (entget name)) (setq ps (cdr (assoc 10 nameall))) (setq pe (cdr (assoc 11 nameall))) (setq psx (car ps)) (setq psy (cadr ps)) (setq psz (caddr ps)) (setq pex (car pe)) (setq pey (cadr pe)) (setq pez (caddr pe)) (setq x (- psx pex)) (setq y (- psy pey)) (setq z (- psz pez)) (setq length (sqrt (+ (expt x 2) (expt y 2) (expt z 2)))) (setq s (+ s length)) ) (princ (strcat 直线总长为：(rtos s))) (princ) ){:em27} 上述为程序内容，然后存为：“文件名.lsp”，再从 CAD 里用 appload 命令加载此文件。 这里有一个程序，你可以用用看， 命令为 AM 对 line ,arc ,ellispe,spline,polyline,lwpolyline,circle,mline,solid 均有效。 你既可统计长度，也可统计面积，或者两者都统计。 如果你对精确位不满意，你可以改动程序中的数字（我已经在程序注释中说明）。 ;;;=================== ;;;面积和长度统计程序 ;;;highflybird kunming ;;;=================== (prompt 命令为:AM) (defun C:am (/ f ss l i SSarea totlen entlen ename name obj text-S text-L insPt0 height insPt1 insPt2 text-1 text-2 *APP *DOC *MSP ) (vl-load-com) (setq *APP (vlax-get-acad-object)) (setq *DOC (vla-get-activeDocument *APP)) (setq *MSP (vla-get-Modelspace *DOC)) (initget 1 1 2 3) (setq f (getkword \n 请输入你要统计的1面积2长度3两者:)) (if (and (setq ss (ssget)) (setq insPt0 (getpoint \n 请输入文字插入点: )) (setq height (getdist \n 请输入文字高度:)) ) (progn (setq l (sslength ss)) (setq i 0) (setq SSarea 0) (setq totlen 0) (setq insPt1 (vlax-3d-point insPt0)) (setq insPt2 (polar insPt0 (* 1.5 Pi) (* 1.5 height))) (setq insPt2 (vlax-3d-point insPt2)) (cond ( (= f 1) (repeat l (func-1) (func-2) (setq i (1+ i)) ) (setq text-S (strcat (convert1 SSarea 6) 平方米));总面积为:小数后 6 位 (vla-addtext *MSP text-S insPt1 height) ) ( (= f 2) (repeat l (func-1) (func-3) (setq i (1+ i)) ) (setq text-L (strcat (convert1 totlen 4) 米)) ;总长度为:小数后 4 位 (vla-addtext *MSP text-L insPt2 height) ) ( (= f 3) (repeat l (func-1) (func-2) (func-3) (setq i (1