[编程交流] 帮助，获取值属性Blo

(defun c:Test (/ ss i sn vl p lst bks s d at l a f o)
 ;;    Author : Tharwat Al Shoufi    ;;
 ;;    Date :    08. Feb. 2014        ;;
 (princ
   "\n Select Dimensions with Attributed Block < Buble > "
 )
 (if (setq ss (ssget '((-4 . "<OR")
                       (0 . "DIMENSION")
                       (-4 . "<AND")
                       (0 . "INSERT")
                       (2 . "Buble")
                       (-4 . "AND>")
                       (-4 . "OR>")
                      )
              )
     )
   (repeat (setq i (sslength ss))
     (setq sn (ssname ss (setq i (1- i)))
           vl (vlax-ename->vla-object sn)
     )
     (if (eq (cdr (assoc 0 (entget sn))) "DIMENSION")
       (progn
         (if (/= (vla-get-Arrowhead1Block vl)
                 "None"
             )
           (setq p (cdr (assoc 13 (entget sn))))
           (setq p (cdr (assoc 14 (entget sn))))
         )
         (setq
           lst
            (cons (list p
                        (rtos (cdr (assoc 42 (entget sn))) 2 0)
                  )
                  lst
            )
         )
       )
       (setq bks (cons (list (cdr (assoc 10 (entget sn))) vl) bks))
     )
   )
 )
 (foreach x lst
   (if (and (car x) (car bks))
     (progn
       (setq d  (distance (car x) (caar bks))
             at (cadr (car bks))
       )
       (foreach e bks
         (if (< (setq a (distance (car x) (car e))) d)
           (setq d  a
                 at (cadr e)
           )
         )
       )
     )
   )
   (if bks
     (setq l
            (cons
              (append
                (mapcar '(lambda (u)
                           (list (vla-get-tagstring u) (vla-get-textstring u))
                         )
                        (vlax-invoke at 'getattributes)
                )
                (list
                  (cadr x)
                )
              )
              l
            )
     )
   )
   (setq lst (cdr lst))
 )
 (if l
   (progn
     (setq l (vl-sort l
                      '(lambda (j k)
                         (< (atof (cadr (car j)))
                            (atof (cadr (car k)))
                         )
                       )
             )
     )
     (if (and (setq f
                     (strcat
                       (getvar 'DWGPREFIX)
                       (vl-filename-base (getvar 'DWGNAME))
                       ".csv"
                     )
              )
              (setq o (open f "w"))
         )
       (progn
         (setq s
                (cond ((vl-registry-read
                         "HKEY_CURRENT_USER\\Control Panel\\International"
                         "sList"
                       )
                      )
                      (",")
                )
         )
         (write-line
           (strcat "NUMBER"        s       "DIMENSION"     s
                   "HEIGHT"        s       "H1"    s       "H2"
                   s       "H4"    s       "3F"
                  )
           o
         )
         (foreach u l
           (write-line
             (strcat
               (nth 1 (nth 0 u))
               s
               (nth 6 u)
               s
               (nth 1 (nth 1 u))
               s
               (nth 1 (nth 2 u))
               s
               (nth 1 (nth 3 u))
               s
               (nth 1 (nth 4 u))
               s
               (nth 1 (nth 5 u))
             )
             o
           )
         )
         (close o)
         (princ (strcat "\n File path : < " f " > "))
       )
       (alert "Unable to open or create CSV file for writing !!")
     )
   )
 )
 (princ)
)
(vl-load-com)