挑战一下这个难题

zhuoxiaoxin · 发表于 2010-8-29 21:22:00

如果不带文字的块有难度,那不带文字的块不处理也行呀

357785513 · 发表于 2010-8-30 12:22:00

真的行嘛,转成属性块之后得考滤它的属性标记,提示,还有属性的值哦,看来十楼的有几分成功的把握哦,

Gu_xl · 发表于 2010-8-30 16:35:00

可以实现的！先提供个思路，等我有空把代码写出来在发上来！

首先找到图中所有块，逐个遍历每个块，有文字的提取出来，将块定义增加这个属性定义，属性定义的Tag value prompt都赋值为文本内容，然后删除块定义中的文字，没有文字的增加一个空白属性定义，所有块定义重定义完成后，提取图中所有的块实体，根据每个块实体的具体位置、图层等信息重新插入该块！因为块定义好后，再增加属性定义，只能对其定义之后插入的块起作用！

zhuoxiaoxin · 发表于 2010-8-30 21:54:00

13楼楼主思路清淅,分工明确,有节有序,看来离成功又近了一步,

Gu_xl · 发表于 2010-8-31 09:11:00

程序写好了，发上来请大家测试

(defun c:tt(/ flag blks blk obj objblock *AcDocument*
*Model-Space* obj1 blks Height mode $Prompt
InsertionPoint Tag Value la color xscale
yscale ascale 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 objblk Height Mode $Prompt InsertionPoint Tag Value))
(vla-put-Layer obj1 la)
(vla-put-Color obj1 color)
(vla-put-Rotation obj1 Rotaion)
(vla-delete obj)
)
)
)
(if flag
(vla-AddAttribute objblk 1 0 "" (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 41 enlst))
yscale (cdr (assoc 42 enlst))
zscale (cdr (assoc 43 enlst))
Rotaion (cdr (assoc 50 enlst))
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) blockname xscale yscale zscale Rotaion))
(vla-put-layer obj la)
(if color (vla-put-color obj color))
(setq n (1+ n))
)
(princ)
)

(defun c:tt(/ flag  blks     blk        obj   objblock   *AcDocument*
       *Model-Space*     obj1       blks   Height     mode $Prompt
       InsertionPoint     Tag        Value   la      color xscale
       yscale  ascale     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 objblk  Height  Mode  $Prompt  InsertionPoint  Tag  Value))
 (vla-put-Layer obj1 la)
 (vla-put-Color obj1 color)
 (vla-put-Rotation obj1 Rotaion)
 (vla-delete obj)
 )
      
      )
    )
  (if flag
    (vla-AddAttribute objblk 1  0  ""  (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 41  enlst))
   yscale (cdr (assoc 42  enlst))
   zscale (cdr (assoc 43  enlst))
   Rotaion (cdr (assoc 50  enlst))
   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) blockname  xscale yscale zscale Rotaion))
    (vla-put-layer obj la)
    (if color (vla-put-color obj color))
    (setq n (1+ n))
    )
  (princ)
  )

zhuoxiaoxin · 发表于 2010-8-31 23:04:00

看来Gu_xl先生程序有点眉目了,等加班回家去试试看

zhuoxiaoxin · 发表于 2010-9-1 12:18:00

根据昨天晚上与今天早上测试无法通过,出现

"块中文字转属性的程序！编制：Gu_xl 2010年8月31日。; 错误: no function definition: GXL-TABLE"

不解的是GXL-TABLE是那里来的呀

wen1234 · 发表于 2010-9-2 22:14:00

咦,一楼的想法还真不错.确实,这样的程序值得程序员写.

因为发发给某块加上属性值也方便,,

有时发现这个块做成了一个普通块后,而后想加点注释之类的,

比如,TPN, 30A之类了,又加进去了.如果编辑块.

做到块里面,而它的属性值又是一样的,所以转成属性块后就好办了,

想要什么值就给什么值,为什么cad它自己不有这样的功能呢,

看来这是CAD公司的一大失误呀,不错,一楼真是高人,想得深,

建议CAD公司能完美这一点不足,通过程序写的话可能要写很长很长,

如果不考滤全面,就像Gu_xl 先生写的.会出错,我也Gu_xl 先生的程序了,

wen1234 · 发表于 2010-9-5 17:12:00

真是遗憾,这么好的贴子没人顶.CAD这么大的缺陷没人补,楼主一份心思怕是白费了,楼主自己也不顶一顶.,难道楼主不成功便失踪了,

357785513 · 发表于 2010-9-5 22:46:00

仁兄,不要感到遗憾,Gu_xl先生的程序我也反复测试过好多次,结果跟wen1234的结果一样,是失败了,这当然不是一般的难啦,因为块的种类很多,而且做块的参数也多,有块套块,无名块,属性块呀,因为图里如果有这些块你得考滤,话他虽说普通块而已,而是含有文字与不含有文字,如果是单单把含有文字的块变成属性块.可能还行吧,不过咱不太会写程序,就不在此乱啃了,还是那句老话,看后五百年吧,

账号		自动登录	找回密码
密码			注册

[基础] 挑战一下这个难题

不错这样的程序值得写,