[编程交流] 具有属性的块需要hel

(defun c:Test (/ s)
 (and (setq s (car (nentsel "\n pick on Attribute :")))
      (member '(0 . "ATTRIB") (entget s))
      (princ (strcat "\n The attribute value : < " (cdr (assoc 1 (entget s))) " > " ))
 )
 (princ)
)

(defun c:Test (/ *error* z o s _doc gc:GetObjectIdString)
 ;;;        Tharwat 05.01.2014        ;;;
 (defun *error* (msg)
   (if z
     (setvar 'DIMZIN z)
   )
   (if (wcmatch (strcase msg) "*CANCEL*,*EXIT*,*BREAK*")
     (princ (strcat "Error :" msg " ..."))
   )
 )
 (defun gc:GetObjectIdString (obj) ;;; By Gile
   (or *util* (setq *util* (vla-get-Utility _doc)))
   (if (vlax-method-applicable-p *util* 'GetObjectIdString)
     (vla-GetObjectIdString *util* obj :vlax-false)
     (itoa (vla-get-ObjectId obj))
   )
 )
 (setq z (getvar 'DIMZIN))
 (setvar 'DIMZIN 0)
 (vla-startUndomark
   (setq _doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (princ "\n Pick a Polyline/Line/Spline ")
 (and
   (setq o (ssget "_+.:S:E" '((0 . "*POLYLINE,LINE"))))
   (setq s (car (nentsel "\n pick on Attribute :")))
   (member '(0 . "ATTRIB") (entget s))
   (entmod
     (subst
       (cons
         1
         (strcat
           "%<\\AcObjProp Object(%<\\_ObjId "
           (gc:GetObjectIdString (vlax-ename->vla-object (ssname o 0)))
           ">%).Length \\f "%lu2">%"
         )
       )
       (assoc 1 (entget s))
       (entget s)
     )
   )
 )
 (vla-regen _doc acallviewports)
 (vla-Endundomark _doc)
 (*error* nil)
 (princ)
)(vl-load-com)