(用户选择的)折线的总长度

;   Length/Area of Polyline by Layer
;   David Bethel May 2004 from an original idea by David Watson
;   This command will give a total area or length for all polylines on a specified layer.
;
(defun c:zone ( / ss la rv i tv op en) 
 
 
   (while (not ss) 
          (princ "\nPick any object on the required layer") 
          (setq ss (ssget))) 
 
 
   (initget "Length Area") 
   (setq rv (getkword "\nWould you like to measure Length/ : ")) 
   (and (not rv) 
        (setq rv "Area")) 
 
 
   (setq la (cdr (assoc 8 (entget (ssname ss 0)))) 
         ss (ssget "X" (list (cons 0 "*POLYLINE") 
                             (cons 8 la))) 
          i (sslength ss) 
         tv 0 
         op 0) 
   (while (not (minusp (setq i (1- i)))) 
          (setq en (ssname ss i)) 
          (command "_.AREA" "_E" en) 
          (cond ((= rv "Length") 
                 (setq tv (+ tv (getvar "PERIMETER")))) 
                (T 
                 (setq tv (+ tv (getvar "AREA"))) 
                 (if (/= (logand (cdr (assoc 70 (entget en))) 1) 1) 
                     (setq op (1+ op)))))) 
 
 
   (princ (strcat "\nTotal " rv 
                  " for layer " la 
                  " = " (rtos tv 2 2) 
                  " in " (itoa (sslength ss)) " polylines\n" 
                  (if (/= rv "Length") 
                      (strcat (itoa op) " with open polylines") ""))) 
   (prin1))

;;--------------------=={ Total Length }==--------------------;;
;;                                                            ;;
;;  Displays the total length of selected objects at the      ;;
;;  command line. The units and precision format of the       ;;
;;  printed result is dependent upon the settings of the      ;;
;;  LUNITS & LUPREC system variables respectively.            ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
 
(defun c:tlen ( / e i l s )
    (if (setq s
            (ssget
               '(   (0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE")
                    (-4 . "
                        (-4 . "
                            (0 . "POLYLINE") (-4 . "&") (70 . 80)
                        (-4 . "AND>")
                    (-4 . "NOT>")
                )
            )
        )
        (progn
            (setq l 0.0)
            (repeat (setq i (sslength s))
                (setq e (ssname s (setq i (1- i)))
                      l (+ l (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
                )
            )
            (princ "\nTotal Length: ")
            (princ (rtos l))
        )
    )
    (princ)
)
(vl-load-com) (princ)

(defun c:AddLength (/ *error* ss l p)
  
  (defun *error* (msg)
    (if ss (vla-delete ss))
    (cond ((not msg))                                                   ; Normal exit
          ((member msg '("Function cancelled" "quit / exit abort")))    ;  or (quit)
          ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
    )
    (princ)
  )
  
  (if (ssget "_:L" '((0 . "AECC_PIPE,ARC,LINE,*POLYLINE")))
    (progn
      (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
        (cond
          ((= "AeccDbPipe" (vla-get-objectname x))
           ;;
           (setq p (cons (vlax-get x 'length2d) p))
          )
          ((setq l
                  (cons
                    (vlax-get x
                              (if (= "AcDbArc" (vla-get-objectname x))
                                'arclength
                                'length
                              )
                    )
                    l
                  )
           )
          )
        )
      )
      (if p
        (prompt (strcat "\nTotal pipe length: "
                        (rtos (setq p (apply '+ p)) 2 2)
                        " LF | "
                        (rtos (/ p 3.0) 2 2)
                        " LY | "
                        (rtos (/ p 5280.0) 2 2)
                        " MI "
                )
        )
      )
      (if l
        (prompt (strcat "\nTotal length: "
                        (rtos (setq l (apply '+ l)) 2 2)
                        " LF | "
                        (rtos (/ l 3.0) 2 2)
                        " LY | "
                        (rtos (/ l 5280.0) 2 2)
                        " MI "
                )
        )
      )
    )
  )
  (*error* nil)
)
 

(defun c:AddArea (/ *error* ss area)
 
  (defun *error* (msg)
    (if ss (vla-delete ss))
    (cond ((not msg))                                                   ; Normal exit
          ((member msg '("Function cancelled" "quit / exit abort")))    ;  or (quit)
          ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
    )
    (princ)
  )
  
  (if (ssget '((0 . "CIRCLE,HATCH,*POLYLINE")))
    (progn
      (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
        (setq area (cons (vla-get-area x) area))
      )
      (prompt (strcat "\nTotal area: "
                      (rtos (setq area (apply '+ area)) 2 2)
                      " SF | "
                      (rtos (/ area 9.0) 2 2)
                      " SY | "
                      (rtos (/ area 43560.0) 2 2)
                      " AC "
              )
      )
    )
  )
  (*error* nil)
)