[编程交流] 到的多段线的面积和句柄

(defun c:test ( / area en nm pt )
(if (setq en (ssget "_:S" '((0 . "LWPOLYLINE") (70 . 1))))
 (if (vl-catch-all-error-p
      (setq area (vl-catch-all-apply 'vlax-curve-getarea (list (ssname en 0))))
     )
   (princ "\nInvalid Object.")
   )
  (setq handle (cdr (assoc 5 (entget en))))
  )
 
(setq area (rtos (/ area 144.0) 2 2))
 (if (setq block (ssget "_:S" '((0 . "INSERT"))))
(progn
 (setq block (ssname block 0))
 (LM:vl-SetAttributeValue (vlax-ename->vla-object block) "NET_SQ_FEET" area)
 (LM:vl-SetAttributeValue (vlax-ename->vla-object block) "ACAD_HANDLE" handle)
) 
)
 
   (princ)
)
(vl-load-com) (princ)
;;----------------=={ Set Attribute Value }==-----------------;;
;;                                                            ;;
;;  Populates the first attribute matching the tag specified  ;;
;;  found within the block supplied with the value specified, ;;
;;  if present.                                               ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  block - VLA Block Reference Object                        ;;
;;  tag   - Attribute TagString                               ;;
;;  value - Value to which the Attribute will be set          ;;
;;------------------------------------------------------------;;
;;  Returns:  Value the attribute was set to, else nil        ;;
;;------------------------------------------------------------;;
(defun LM:vl-SetAttributeValue ( block tag value )
   (setq tag (strcase tag))
   (vl-some
       (function
           (lambda ( attrib )
               (if (eq tag (strcase (vla-get-TagString attrib)))
                   (progn
                       (vla-put-TextString attrib value)
                       value
                   )
               )
           )
       )
       (vlax-invoke block 'GetAttributes)
   )
)