<p>首先找到图中所有块，逐个遍历每个块，有文字的提取出来，将块定义增加这个属性定义，属性定义的Tag value prompt都赋值为文本内容，然后删除块定义中的文字，没有文字的增加一个空白属性定义，所有块定义重定义完成后，提取图中所有的块实体，根据每个块实体的具体位置、图层等信息重新插入该块！因为块定义好后，再增加属性定义，只能对其定义之后插入的块起作用！</p> <p>13楼楼主思路清淅,分工明确,有节有序,看来离成功又近了一步,</p> 程序写好了，发上来请大家测试
(defun c:tt(/ flagblks blk obj objblock *AcDocument*
*Model-Space* obj1 blks Height mode $Prompt
InsertionPoint Tag Value la color xscale
yscaleascale Rotaion enlst
) ;_ /
(princ "\n块中文字转属性的程序！编制：Gu_xl 2010年8月31日。")
(setq *AcDocument* (vla-get-activedocument (vlax-get-acad-object))
*Model-Space* (vla-get-modelspace *AcDocument*))
(setq blks (GXL-TABLE "block"))
(foreach blk blks
(setq flag t)
(setq objblk (vla-Item (vla-get-Blocks *ACDOCUMENT*) blk))
(vlax-for obj objblk
(if (= "AcDbText" (vla-get-ObjectName obj))
(progn
(setq flag nil)
(setq Height (vla-get-Height obj)
mode 0
$Prompt (vla-Get-textString obj)
InsertionPoint (vla-get-InsertionPoint obj)
Tag (vla-Get-textString obj)
Value (vla-Get-textString obj)
la (vla-get-Layer obj)
color (vla-get-color obj)
Rotaion (vla-get-Rotation obj)
)
(setq obj1 (vla-AddAttribute objblkHeightMode$PromptInsertionPointTagValue))
(vla-put-Layer obj1 la)
(vla-put-Color obj1 color)
(vla-put-Rotation obj1 Rotaion)
(vla-delete obj)
)
)
)
(if flag
(vla-AddAttribute objblk 10""(vla-get-Origin objblk)"" "")
)
)
(setq ss (ssget "x" '((0 . "insert"))))
(setq n 0)
(repeat (sslength ss)
(setq en (ssname ss n))
(setq enl (member '(100 . "AcDbEntity") (setq enlst(entget en))))
(entdel en)
(setq xscale (cdr (assoc 41enlst))
yscale (cdr (assoc 42enlst))
zscale (cdr (assoc 43enlst))
Rotaion (cdr (assoc 50enlst))
blockname (cdr (assoc 2 enlst))
InsertionPoint (cdr(assoc 10 enlst))
la (cdr (assoc 8 enlst))
color (cdr (assoc 62 enlst))
)
(setq obj (vla-InsertBlock *Model-Space* (vlax-3d-point InsertionPoint) blocknamexscale yscale zscale Rotaion))
(vla-put-layer obj la)
(if color (vla-put-color obj color))
(setq n (1+ n))
)
(princ)
)
看来<font face="Verdana" color="#61b713"><b>Gu_xl</b></font>先生程序有点眉目了,等加班回家去试试看 <p>根据昨天晚上与今天早上测试无法通过,出现</p>
<p><font face="Verdana">"块中文字转属性的程序！编制：Gu_xl 2010年8月31日。; 错误: no function definition: GXL-TABLE"</font></p>
<p> </p>
<p><font face="Verdana"><br/>不解的是GXL-TABLE是那里来的呀</p></font>
不错这样的程序值得写,
<p><font color="#000000" size="4">咦,一楼的想法还真不错.确实,这样的程序值得程序员写.</font></p><p><font color="#000000" size="4">因为发发给某块加上属性值也方便,,</font></p>
<p><font color="#000000" size="4">有时发现这个块做成了一个普通块后,而后想加点注释之类的,</font></p>
<p><font color="#000000" size="4">比如,TPN, 30A之类了,又加进去了.如果编辑块.</font></p>
<p><font color="#000000" size="4">做到块里面,而它的属性值又是一样的,所以转成属性块后就好办了,</font></p>
<p><font color="#000000" size="4">想要什么值就给什么值,为什么cad它自己不有这样的功能呢,</font></p>
<p><font color="#000000" size="4">看来这是CAD公司的一大失误呀,不错,一楼真是高人,想得深,</font></p>
<p><font color="#000000" size="4">建议CAD公司能完美这一点不足,通过程序写的话可能要写很长很长,</font></p>
<p><font color="#000000" size="4">如果不考滤全面,就像Gu_xl 先生写的.会出错,我也Gu_xl 先生的程序了,</font></p> <p><font size="4">真是遗憾,这么好的贴子没人顶.CAD这么大的缺陷没人补,楼主一份心思怕是白费了,楼主自己也不顶一顶.,难道楼主不成功便失踪了,</font></p> <p><font size="2">仁兄,不要感到遗憾,<font face="Verdana" color="#61b713"><b>Gu_xl</b></font>先生的程序我也反复测试过好多次,结果跟<font face="Verdana" color="#61b713"><b>wen1234</b></font>的结果一样,是失败了,这当然不是一般的难啦,因为块的种类很多,而且做块的参数也多,有块套块,无名块,属性块呀,因为图里如果有这些块你得考滤,话他虽说普通块而已,而是含有文字与不含有文字,如果是单单把含有文字的块变成属性块.可能还行吧,不过咱不太会写程序,就不在此乱啃了,还是那句老话,看后五百年吧,</font></p>