[编程交流] 我需要一个用于Lis的Autocad LISP

; This updates a block with 4 attributes 
; Just insert block with 4 attributes 1st 
; insert block or copy etc
; by Alan H June 2017
(defun c:blk4 ( / len t1 t2 obj desc x att )
(vl-load-com)
(while (/=  (vlax-property-available-p (setq obj (vlax-ename->vla-object (car (entsel "Select Block")))) 'Hasattributes) T)
(alert "You have not picked a block object ")
)
(setq att (vlax-invoke obj 'getattributes))
(while (/=  (vlax-property-available-p (setq len (vlax-ename->vla-object (car (entsel "\nSelect Line: ")))) 'length) T)
(alert "You have not picked a P/line object ")
)
(while (/=  (vlax-property-available-p (setq t1   (vlax-ename->vla-object (car (entsel "\nSelect Text 1: ")))) 'Textstring) T)
(alert "You have not picked a text object ")
)
(while (/=  (vlax-property-available-p (setq t2   (vlax-ename->vla-object (car (entsel "\nSelect Text 2: ")))) 'Textstring) T)
(alert "You have not picked a text object ")
)
(while (/=  (vlax-property-available-p (setq desc (vlax-ename->vla-object (car (entsel "\nSelect Description : ")))) 'Textstring) T)
(alert "You have not picked a text object ")
)
(setq atlength (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid len)) ">%).Length>%"))
(setq att1     (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid t1)) ">%).TextString>%"))
(setq att2     (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid t2)) ">%).TextString>%"))
(setq atdesc   (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid desc)) ">%).TextString>%"))
; this is for 1st 4 attributes starts at 0 not 1 tested on block with 16 attributes.
(vla-put-textstring (nth 0 att) atlength)
(vla-put-textstring (nth 1 att) atdesc)
(vla-put-textstring (nth 2 att) att1)
(vla-put-textstring (nth 3 att) att2)
(command "regen")
(princ)
) ; defun
(c:blk4)

; http://www.cadtutor.net/forum/showthread.php?100975-I-need-an-Autocad-LISP-for-Listing-Beam-Sizes
; Simple field attributes - original concept by BIGAL
(defun C:test ( / e )
 (and (or (setq e (car (entsel "\nSelect attributed block: "))) (prompt "\nInvalid selection."))
   (vl-every '(lambda (x) (member x (entget e))) '((0 . "INSERT") (66 . 1)))
   (progn
     (foreach att (vlax-invoke (vlax-ename->vla-object e) 'GetAttributes)
       (and (vlax-write-enabled-p att)
         (setq e (car (nentsel (strcat "\nSelect object for "" (vla-get-TagString att) "" attribute: "))))
         (vl-some 
           '(lambda (x) 
             (if (vlax-property-available-p (vlax-ename->vla-object e) x)
               (vla-put-TextString att 
                 (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                   (itoa (vla-get-ObjectId (vlax-ename->vla-object e)))
                   ">%)." x ">%"
                 ); strcat 
               ); vla-put-TextString
             ); if 
           ); lambda 
           '("Length" "TextString") ; "Area" could be added, list is sorted by priority
         ); vl-some
       ); and 
     ); foreach
     (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
   ); progn
 ); and
 (princ)
); defun