分解为Tex的属性标记
是否有程序将分解的属性标记更改为整个图形是否显示在屏幕上?该程序可能在
lisp或VBA。希望这将是一个能够改变
一次绘制整个图形,但其他选择方法将很有用。
有人试过为分解的标签制作程序吗?。
非常感谢。 为什么不使用BURST-in Express工具来分解标签 是的,我也经常使用突发命令。
试试这个
(defun C:BURST_TO_GROUPS
(/ sset loop ENAME count
space tlmde dynmdelen 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
因此,burst将保留标记中的原始文本。
非常感谢。 如果希望属性值成为文本,则“突发”将起作用。如果希望将属性提示视为文本,则需要其他内容。
几个月前,当我需要它的时候,有人给了我一个Lisp程序的口吻,但我不是一杯好威士忌的另一半去寻找它。
我认为这有点相关(由David Bethel修改的代码):
(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)) 李,这不是从文本中生成属性吗?我只是从标题上猜测,没有时间好好阅读。
无论如何,为了完整起见,这是我的帖子。。。
http://www.cadtutor.net/forum/showthread.php?t=36513&highlight=attribute+文本 啊,当然了-搞错了
页:
[1]