[编程交流] 分解为Tex的属性标记

 
(defun C:BURST_TO_GROUPS
   (/   sset   loop   ENAME   count
    space   tlmde   dynmde  len   num
    OBJ   NAME   VLA-OBJ NEWNAME TMP
    lst
   )
 (setq tlmde  (getvar "TILEMODE")
dynmde (getvar "DYNMODE")
 ) ;_ end of setq
 (setvar "CMDECHO" 0)
 (setvar "DYNMODE" 0)
 (setq loop 1
count 0
 ) ;_ end of setq
 (command "_AUDIT" "_Yes")
 (if (null border_tmp)
   (SEARCH_BORDER)
 ) ;_ end of if
 (while (and (< loop 4)
      (setq lst (acet-table-name-list (list "BLOCK" 1 4 16)))
 ) ;_ end of and
   (if border_tmp
     (setq lst (vl-remove border_name lst))
   ) ;_ end of if
   (if title_tmp
     (setq lst (vl-remove title_name lst))
   ) ;_ end of if
   (setq len (length lst))
   (while (> len 0)
     (setq sset (ssget "_X"
  (list (cons 0 "INSERT")
        (cons 2 (nth (setq len (1- len)) lst))
  ) ;_ end of list
  ) ;_ end of ssget
     ) ;_ end of setq
     (if (and sset
       (setq obj (ssname sset 0))
       (= (cdr (assoc 0 (entget obj))) "INSERT")
       (setq name (cdr (assoc 2 (entget obj))))
       (setq VLA-OBJ (vlax-ename->vla-object obj))
  ) ;_ end of and
(progn
  (setq nbr 0)
  (while (tblobjname
    "BLOCK"
    (setq newname (strcat name "_" (itoa nbr)))
  ) ;_ end of tblobjname
    (setq nbr (1+ nbr))
  ) ;_ end of while
  (and
    (vlax-method-applicable-p VLA-OBJ 'ConvertToStaticBlock)
    (not (vl-catch-all-error-p
    (vl-catch-all-apply
      'vla-ConvertToStaticBlock
      (list VLA-OBJ newname)
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of vl-catch-all-error-p
    ) ;_ end of not
    (not
      (vl-catch-all-error-p
 (vl-catch-all-apply
   'vlax-put-property
   (list
     (vla-item
       (vla-get-blocks
  (vla-get-activedocument (vlax-get-acad-object))
       ) ;_ end of vla-get-blocks
       newname
     ) ;_ end of vla-item
     'Explodable
     :vlax-true
   ) ;_ end of list
 ) ;_ end of vl-catch-all-apply
      ) ;_ end of vl-catch-all-error-p
    ) ;_ end of not
  ) ;_ end of and
  (command "._PURGE" "_Block" name "_No")
  (if newname
    (setq sset
    (ssget "_X" (list (cons 0 "INSERT") (cons 2 newname)))
    ) ;_ end of setq
  ) ;_ end of if
  (if sset
    (progn
      (setq ENAME (ssname sset 0)
     space (cdr (assoc 410 (entget ENAME)))
      ) ;_ end of setq
      (if (= space "Model")
 (command "_TILEMODE" "1")
 (command "_TILEMODE" "0")
      ) ;_ end of if
      (BURST-ONE ENAME)
      (command "._PURGE" "_Block" NEWNAME "_No")
      (setq count (1+ count))
      (command
 "_-GROUP"
 "_Create"
 (strcat (substr (rtos (getvar "CDATE") 2 6) 3 6)
  (substr (rtos (getvar "CDATE") 2 6) 11 6)
  "_"
  (itoa count)
 ) ;_ end of strcat
 "_Block"
 "_P"
 ""
      ) ;_ end of command
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of progn
     ) ;_ end of if
   ) ;_ end of while
   (setq loop (1+ loop))
 ) ;_ end of while
 (command "_AUDIT" "_Yes")
 (command "_TILEMODE" tlmde)
 (setvar "DYNMODE" dynmde)
 (princ)
) ;_ end of defun

(defun c:txt2atta (/ ss i en ed)
 (vl-load-com)
 (while (not ss)
        (princ "\nSelect TEXT to Convert to ATTDEF:   ")
        (setq ss (ssget (list (cons 0 "TEXT")
                              (cons 410 (getvar "CTAB"))))))
 (setq i (sslength ss))
 (while (not (minusp (setq i (1- i))))
        (setq en (ssname ss i)
              ed (entget en)
              ed (subst (cons 1
                          (vl-string-subst "_" " "
                            (cdr (assoc 1 ed))))
                        (assoc 1 ed) ed))
   (entmake (list (cons 0 "ATTDEF")
                  (assoc 8 ed)
                  (assoc 10 ed)
                  (assoc 11 ed)
                  (assoc 7 ed)
                  (assoc 40 ed)
                  (assoc 41 ed)
                  (assoc 50 ed)
                  (assoc 51 ed)
                  (cons 70 0)
                  (assoc 71 ed)
                  (assoc 72 ed)
                  (cons 74 (cdr (assoc 73 ed)))
                  (assoc 210 ed)
                  (assoc 1 ed)
                  (cons 2 (cdr (assoc 1 ed)))
                  (cons 3 (cdr (assoc 1 ed)))
                  (if (assoc 6 ed) (assoc 6 ed)'(6 . "BYLAYER"))
                  (if (assoc 39 ed) (assoc 39 ed)'(39 . 0))
                  (if (assoc 62 ed) (assoc 62 ed)'(62 . 256))))
   (entdel en))
 (redraw)
 (prin1))