计算选取曲线的总长度

Lisphk

1. (defun C:GetLength ( / CurEnt CurLgt CurObj CurSet FltLst ObjCnt TmpLgt)
   
2. (if (< (atof (getvar "ACADVER")) 15.0)
   
3.   (alert "GetLength requires AutoCAD 2000 or higher. ")
   
4.   (progn
   
5.    (vl-load-com)
   
6.    (setq FltLst '(
   
7.                   (0 . "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE,POLYLINE,SPLINE")
   
8.                   (-4 . "<NOT")
   
9.                    (-4 . "<OR")
   
10.                     (-4 . "&=") (70 . 16)  ;3DMesh
    
11.                     (-4 . "&=") (70 . 64)  ;PolyFace
    
12.                    (-4 . "OR>")
    
13.                   (-4 . "NOT>")
    
14.                  )
    
15.          CurLgt 0.0
    
16.    )
    
17.    (if (setq CurSet (cond ((ssget "I" FltLst)) ((ssget FltLst))))
    
18.     (progn
    
19.      (setq ObjCnt (sslength CurSet))
    
20.      (while (setq CurEnt (ssname CurSet 0))
    
21.       (setq CurObj (vlax-ename->vla-object CurEnt)
    
22.             TmpLgt (vlax-curve-getDistAtParam CurObj
    
23.                     (vlax-curve-getEndParam CurObj)
    
24.                    )
    
25.             CurLgt (+ CurLgt TmpLgt)
    
26.       )
    
27.       (ssdel CurEnt CurSet)
    
28.      )
    
29.      (alert
    
30.       (strcat
    
31.        "Total length of "
    
32.        (itoa ObjCnt) " object(s): "
    
33.        (rtos CurLgt) " units. "
    
34.       )
    
35.      )
    
36.     )
    
37.    )
    
38.   )
    
39. )
    
40. (princ)
    
41. )
    

(defun C:GetLength ( / CurEnt CurLgt CurObj CurSet FltLst ObjCnt TmpLgt)<br /> (if (< (atof (getvar "ACADVER")) 15.0)<br />   (alert "GetLength requires AutoCAD 2000 or higher. ")<br />   (progn<br />    (vl-load-com)<br />    (setq FltLst '(<br />                   (0 . "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE,POLYLINE,SPLINE")<br />                   (-4 . "<NOT")<br />                    (-4 . "<OR")<br />                     (-4 . "&=") (70 . 16)  ;3DMesh<br />                     (-4 . "&=") (70 . 64)  ;PolyFace<br />                    (-4 . "OR>")<br />                   (-4 . "NOT>")<br />                  )<br />          CurLgt 0.0<br />    )<br />    (if (setq CurSet (cond ((ssget "I" FltLst)) ((ssget FltLst))))<br />     (progn<br />      (setq ObjCnt (sslength CurSet))<br />      (while (setq CurEnt (ssname CurSet 0))<br />       (setq CurObj (vlax-ename->vla-object CurEnt)<br />             TmpLgt (vlax-curve-getDistAtParam CurObj<br />                     (vlax-curve-getEndParam CurObj)<br />                    )<br />             CurLgt (+ CurLgt TmpLgt)<br />       )<br />       (ssdel CurEnt CurSet)<br />      )<br />      (alert<br />       (strcat<br />        "Total length of "<br />        (itoa ObjCnt) " object(s): "<br />        (rtos CurLgt) " units. "<br />       )<br />      )<br />     )<br />    )<br />   )<br /> )<br /> (princ)<br /> )<br />