[求助]打碎块保留属性值程序的问题
 

[求助]打碎块保留属性值程序的问题
www.dimcax.com
[求助]打碎块保留属性值程序的问题
程序是写出来了，可在运行过程中出现不少问题
首先是文字的对齐方式，块属性里为中上，而写出的文字居中，这样就导致打碎后出现版面非常乱。
再就是删除attdef过程也不太正常
请高人修改，谢谢！
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32;打碎块后保留其属性值
;思路：根据attrib写text，打碎块，删除attdef
;参考/codes/articleshow.asp?articleid=1190
( c:def ( tc ss ent1 newtxt )
( tc ( "clayer"))
( "\n请选择需要被打碎的块")
( ss ( '((0 . "insert"))))
( ( n ( ss))
( ent1 ( ( ss ( n (1- n)))))
( "clayer" (get 8 ent1))
( ( (get 0 ( ent1 ( ( (get -1 ent1))))) "seqend")
( ( (get 0 ent1) "attrib")
(
( newtxt '((0 . "text")))
( lst '(67 410 10 40 1 50 41 51 7 71 72 11 210 73))
( xh lst
( dd ( xh ent1))
( ( dd nil)
( newtxt ( newtxt ( ( xh ent1))))
)
)
( newtxt)
);progn
);if
);while
);repeat
( "explode" ss)
( ss ( "_p" '((0 . "attdef"))))
( "erase" ss "")
( "clayer" tc)
()
)
新手上路，请多指点。
d
附图和自定义的get
( get (aaaaa bbbbb /)
( ( aaaaa bbbbb))
)
该文件为 autocad r14 文件，请使用idrop将图形拖放到autocad中直接打开。
新手上路，请多指点。
d
前辈高人们帮帮忙呀！
新手上路，请多指点。
d
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35( blkexp(blkref / adwg owner lst attrs atttextstr tmptext eblks )
; ;首先把其中的可见的属性给分解成文字,然后炸开,然后删除获得的属性,并且重复运行,以便完全炸开镶嵌块--
; ( adwg(vlax-get () 'activedocument)
; owner(vlax-get blkref 'ownerid)
; owner(vlax-invoke adwg 'objectidtoobject owner)
lst '( "alignment" "backward" "color" "layer" "linetypescale" "linetype" "lineweight"
"obliqueangle" "rotation" "scalefactor" "stylename" "textalignmentpoint" "thickness" "upsidedown"))
; ( ( (vlax-get blkref 'hasattributes) -1)
; (
; ( attrs(vlax-invoke blkref 'getattributes))
; ( '((x)( ( ( ( -1 (vlax-get x 'invisible)));可见属性
( ( "" ( atttextstr(vlax-get x 'textstring)))));属性值非""
; (
; ( tmptext(vlax-invoke owner 'addtext atttextstr (vlax-get x 'insertionpoint)
; (vlax-get x 'height)))
; ( '((y)( y( y))(vlax-put tmptext y (vlax-get x y))) lst)
; )
; ))attrs)
; )
; )
; ;上面把属性改成了文字,下面就是炸开块了~~~~~
; ( eblks(vlax-invoke blkref 'explode))
; ( '((x)
( ( "acdbattributedefinition" (vlax-get x 'objectname))
; (vlax-invoke x 'delete);属性删除--
; (
( ( "acdbblockreference" (vlax-get x 'objectname));是块,则继续炸开~~~
; (blkexp x)
; )
; )
; )
; ) eblks)
; (vlax-invoke blkref 'delete)
; ()
)
d
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
;;在不爆開塊下把屬性值提出
;;by lucas
( c:def ( dd ent ent1 lst n newtxt ss tc)
()
( tc ( "clayer"))
( "\n請選擇屬性圖塊")
( ( ss ( '((0 . "insert") (66 . 1))))
( ( n ( ss))
( ent1 ( ( ss ( n (1- n)))))
( "clayer" (get 8 ent1))
(
( (get 0
( ent1 ( ( ent ( (get -1 ent1)))))
)
"seqend"
)
( ( (get 0 ent1) "attrib")
(
( newtxt '((0 . "text")))
( lst '(67 410 10 40 1 50 41 51 7 71 72 11 210))
( xh lst
( dd ( xh ent1))
( ( dd nil)
( newtxt ( newtxt ( ( xh ent1))))
)
)
(
newtxt ( newtxt
( ( 73 ( ( 74 ent1))))
)
)
( newtxt)
(vla-delete ( ent))
)
)
)
)
)
( "clayer" tc)
()
)
( get (aaaaa bbbbb /)
( ( aaaaa bbbbb))
)
要努力学习,不进则退
网络u盘：
感谢前辈们的支持。
4楼的大部分为vlax函数，我这部分实在没有学会，但我把程序记下来了，供以后参考。
5楼的程序非常实用，对我错误的程序稍做改动，便十分完美了。
再次感谢龙龙仔！
新手上路，请多指点。