[编程交流] 在中时获取属性值

(defun c:pen ()
(defun attget (ss1 / en edata)
 (if ss1
  (progn
   (setq en (ssname ss1 0))
   (setq edata (entget en))
   (setq blockdata nil)
   (setq edata (entget (entnext (cdr (assoc -1 edata)))))
   (while (not(= (cdr (assoc 0 edata)) "SEQEND"))
    (setq blockdata (cons (cons  (cdr (assoc 2 edata)) (cdr (assoc 1 edata))) blockdata))
    (setq edata (entget (entnext (cdr (assoc -1 edata)))))
    )
  )
  (progn
   (alert "Their is no block")
   (exit)
  )
 )
)
(defun attput (ss1 / en edata)
 (setq en (ssname ss1 0))
 (setq edata (entget en))
 (setq edata (entget (entnext (cdr (assoc -1 edata)))))
 (while (not(= (cdr (assoc 0 edata)) "SEQEND"))
   (entmod (subst (cons 1 (cdr (assoc (cdr (assoc 2 edata)) blockdata)))(assoc 1 edata) edata))
   (setq edata (entget (entnext (cdr (assoc -1 edata)))))
 )
)
(setq InPoint (getpoint "\nSelect insetion point :"))
(Setq TheString (getstring "\nWhat is the room number :"))
(setq TheScale (getint "What is the scale of insertion? :"))
(setvar "attdia" 0)
;What is the one that turns it off completly?
(command "_.Insert" "roomtag" InPoint TheScale TheScale 0)
(setq TheEntity (ssget (entlast)))
(attget TheEntity)
(setq blockdata (subst (cons "roomnumber" TheString) (assoc "roomnumber" blockdata) blockdata))
(attput TheEntity)
(princ Block Created)
(princ)
)

(cdr (assoc 1 (entget NM)))

(defun c:RmNo (/ doc spc str pt Blk gr dat ent)
 (vl-load-com)
 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc))   str "")
 (if (or (tblsearch "BLOCK" "roomtag")
         (findfile "roomtag.dwg"))
   (if (setq pt (getpoint "\nSpecify Point for Block: "))
     (progn
       (setq Blk
         (vla-insertblock spc
           (vlax-3D-point pt) "roomtag.dwg" 1. 1. 1. 0.))
       (princ "\nSelect or Specify Room Number: ")
       (vl-catch-all-apply
         (function
           (lambda ( )
             (while
               (progn
                 (setq gr (grread t 15 2) dat (cadr gr))
                 (cond
                   ((and (= 3 (car gr)) (listp dat))
                    (if (setq ent (car (nentselp dat)))
                      (if (vl-position
                            (cdr (assoc 0 (entget ent)))
                              '("TEXT" "MTEXT" "ATTRIB"))
                        (progn
                          (setq str
                            (vla-get-TextString
                              (vlax-ename->vla-object ent))) nil)
                        (princ "\n** Invalid Object Selected **"))
                      (princ "\n** Nothing Selected **")))
                   ((= 2 (car gr))
                    (cond ((<= 32 dat 126)
                           (princ (chr dat))
                           (setq str (strcat str (chr dat))))
                          ((= 8 dat)
                           (and (< 0 (strlen str))
                                (princ (strcat (chr  (chr 32) (chr ))
                                (setq str (substr str 1 (1- (strlen str))))))
                          ((= dat 13) nil)))
                   ((= 25 (car gr)) nil)
                   (t t)))))))
       (foreach att
         (append
           (if
             (not
               (vl-catch-all-error-p
                 (setq atArr
                   (vl-catch-all-apply
                     'vlax-safearray->list
                     (list
                       (vlax-variant-value
                         (vla-GetAttributes Blk))))))) atArr)
           (if
             (not
               (vl-catch-all-error-p
                 (setq caArr
                   (vl-catch-all-apply
                     'vlax-safearray->list
                     (list
                       (vlax-variant-value
                         (vla-GetConstantAttributes Blk))))))) caArr))
         (if (eq "ROOMNUMBER"
                 (strcase
                   (vla-get-TagString att)))
           (vla-put-TextString att str))))
     (princ "\n<< No Point Specified >>"))
   (princ "\n<< Block Not Found >>"))
 (princ))