[编程交流] 多段线的面积

(defun c:TesT (/ ss p)
;; Tharwat 18. Nov. 2011 ;;
   (if (and (setq ss (car (entsel "\n Select a closed polyline :")))
            (vlax-curve-IsClosed ss)
       )
       (progn
           (entmake '((0 . "BLOCK")(2 . "_area_")(70 . 0)(10 0.0 0.0 0.0)))
           (entmake
               (list
                   '(0 . "TEXT")
                   '(10 0.0 0.0 0.0)
                   (cons 40 (getvar 'textsize))
                   (assoc 8 (entget ss))
                   (cons 1
                       (strcat
                           (rtos (cvunit (vla-get-area (vlax-ename->vla-object ss)) "inch" "ft")
                                        2 2
                           )
                           "sf"
                       )
                   )
               )
           )  
           (entmake '((0 . "ENDBLK")))
           (prompt "\n ")
           (prompt "\n Specify Text location : ")
           (command "_-insert" "_area_" pause "1" "1" "0")
           (command "_explode" "_L")     
       )
   )
   (princ)
)

(defun c:test ( / area en nm pt )
   (while
       (progn (setvar 'ERRNO 0) (setq en (car (entsel)))
           (cond
               (   (= 7 (getvar 'ERRNO))
                   (princ "\nMissed, try again.")
               )
               (   (eq 'ENAME (type en))
                   (if (vl-catch-all-error-p
                           (setq area (vl-catch-all-apply 'vlax-curve-getarea (list en)))
                       )
                       (princ "\nInvalid Object.")
                   )
               )
               (   (setq area nil)   )
           )
       )
   )
   (if (and area (setq pt (getpoint "\nPoint for Text: ")))
       (entmake
           (list
              '(0 . "TEXT")
               (cons 210 (setq nm (trans '(0.0 0.0 1.0) 1 0 t)))
               (cons  10 (trans pt 1 nm))
               (cons  40 (getvar 'TEXTSIZE))
               (assoc  8 (entget en))
               (cons  50 (angle '(0.0 0.0 0.0) (trans (getvar 'UCSXDIR) 0 nm t)))
               (cons   1 (rtos (/ area 144.0) 2))
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

(rtos (cvunit (vla-get-area (vlax-ename->vla-object ss)) "inch" "ft") 2 2 )

(rtos (/ (vla-get-area (vlax-ename->vla-object ss)) 144.) 2 2 )