如何给标注文字加上填充？

defun

以下方法没有成功
(setq ent (car (entsel)))
(vlax-put-property  (vlax-ename->vla-object ent)  "TextFill"  -1)
(vlax-put-property  (vlax-ename->vla-object ent)  "TextFillColor"  1)

marting

defun 发表于 2018-4-4 12:50
我知道了，cad版本的问题，2008不行，10和14就可以了，2008有办法吗

这是一个ADESK确认的BUG，

正常情况下，给标注添加OVERIDE，都是给标注实体添加扩展实体数据，对于TEXTFILL，正常的XDATA应该是：

(-3 ("ACAD" (1000 . "DSTYLE") (1002 . "{") (1070 . 70)
(1070 . 1) (1070 . 69) (1070 . 2) (1002 . "}"))))


而2008下是

(-3 ("ACAD" (1000 . "DSTYLE") (1002 . "{") (1070 . 70)
(1070 . 1) (1070 . 69) (1070 . 1) (1002 . "}"))))


所以，要想解决2008下这个BUG，就是TEXTFILL后，修改下扩展实体数据，把1改成2.

下面是代码：

1. (defun c:tt ()
   
2.   (if (and (setq e (car (entsel "\n选择标注:")))
   
3.            (wcmatch (vla-get-objectname (setq o (vlax-ename->vla-object e)))
   
4.                     "*Dimension"
   
5.            )
   
6.       )
   
7.     (progn (vla-put-textfill o :vlax-true)
   
8.            (setq ed    (entget e '("ACAD"))
   
9.                  xdata (cadr (assoc -3 ed))
   
10.            )
    
11.            (if (setq val (vl-position (cons 1070 69) xdata))
    
12.              (progn (setq newxdata (list
    
13.                                      (list '-3
    
14.                                            (XD::List:Replace_Nth xdata (1+ val) (cons 1070 2))
    
15.                                      )
    
16.                                    )
    
17.                     )
    
18.                     (entmod (append (entget e) newxdata))
    
19.                     (vla-update o)
    
20.              )
    
21.            )
    
22.       (vla-put-textfillcolor o 1)
    
23.     )
    
24.   )
    
25.   (princ)
    
26. )
    
27. 
    

(defun c:tt ()<br />   (if (and (setq e (car (entsel "\n选择标注:")))<br />            (wcmatch (vla-get-objectname (setq o (vlax-ename->vla-object e)))<br />                     "*Dimension"<br />            )<br />       )<br />     (progn (vla-put-textfill o :vlax-true)<br />            (setq ed    (entget e '("ACAD"))<br />                  xdata (cadr (assoc -3 ed))<br />            )<br />            (if (setq val (vl-position (cons 1070 69) xdata))<br />              (progn (setq newxdata (list<br />                                      (list '-3<br />                                            (XD::List:Replace_Nth xdata (1+ val) (cons 1070 2))<br />                                      )<br />                                    )<br />                     )<br />                     (entmod (append (entget e) newxdata))<br />                     (vla-update o)<br />              )<br />            )<br />       (vla-put-textfillcolor o 1)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

XD::List:Replace_Nth

游客，如果您要查看本帖隐藏内容请回复

sh_h

1. ;试试看
   
2. (vlax-put-property  (vlax-ename->vla-object ent)  "TextFill"  -1);-1--->1 or :vlax-true
   
3. (vlax-put-property (vlax-ename->vla-object ent)  "TextFill" 1)
   
4. (vlax-put-property (vlax-ename->vla-object ent)  "TextFill" :vlax-true)
   

;试试看<br /> (vlax-put-property  (vlax-ename->vla-object ent)  "TextFill"  -1);-1--->1 or :vlax-true<br /> (vlax-put-property (vlax-ename->vla-object ent)  "TextFill" 1)<br /> (vlax-put-property (vlax-ename->vla-object ent)  "TextFill" :vlax-true)<br />

defun

sh_h 发表于 2018-4-4 11:30

试过，没有效果

Lisphk

defun 发表于 2018-4-4 12:07
试过，没有效果

可以啊，你选的是标注吗？

1. (defun c:tt ()
   
2.   (if (and (setq e (car (entsel "\n拾取标注:")))
   
3.            (wcmatch (vla-get-objectname (setq o (vlax-ename->vla-object e))) "*Dimension")
   
4.       )
   
5.     (progn (vlax-put-property
   
6.              o
   
7.              "TextFill"
   
8.              :vlax-true
   
9.            )
   
10.            (vlax-put-property
    
11.              o
    
12.              "TextFillColor"
    
13.              1
    
14.            )
    
15.     )
    
16.   )
    
17.   (princ)
    
18. )
    
19. 
    

(defun c:tt ()<br />   (if (and (setq e (car (entsel "\n拾取标注:")))<br />            (wcmatch (vla-get-objectname (setq o (vlax-ename->vla-object e))) "*Dimension")<br />       )<br />     (progn (vlax-put-property<br />              o<br />              "TextFill"<br />              :vlax-true<br />            )<br />            (vlax-put-property<br />              o<br />              "TextFillColor"<br />              1<br />            )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

defun

Lisphk 发表于 2018-4-4 12:24
可以啊，你选的是标注吗？

我知道了，cad版本的问题，2008不行，10和14就可以了，2008有办法吗

Lisphk

defun 发表于 2018-4-4 12:50
我知道了，cad版本的问题，2008不行，10和14就可以了，2008有办法吗

试了2008，果然不行，但标注替代显示已经设置进去了，那就是2008的BUG了吧

defun

marting 发表于 2018-4-4 14:34
这是一个ADESK确认的BUG，

正常情况下，给标注添加OVERIDE，都是给标注实体添加扩展实体数据，对于TEX ...

果然如此，受教受教

newer

vba的解决方案

1. Sub TEST()
   
2. Dim ou As AcadUtility
   
3. Set ou = ThisDrawing.Utility
   
4. Dim o As Object 'AcadEntity
   
5. Dim pt As Variant
   
6. ou.GetEntity o, pt
   
7. 
   
8. o.TextFill = True
   
9. 
   
10. Dim xdataOut As Variant
    
11. Dim xtypeOut As Variant
    
12. o.GetXData "ACAD", xtypeOut, xdataOut
    
13. If IsArray(xdataOut) Then
    
14. Dim i As Long
    
15. For i = LBound(xdataOut) To UBound(xdataOut)
    
16. If xdataOut(i) = 69 Then
    
17. xdataOut(i + 1) = 1
    
18. Exit For
    
19. End If
    
20. Next
    
21. End If
    
22. o.SetXData xtypeOut, xdataOut
    
23. End Sub

Sub TEST()<br /> Dim ou As AcadUtility<br /> Set ou = ThisDrawing.Utility<br /> Dim o As Object 'AcadEntity<br /> Dim pt As Variant<br /> ou.GetEntity o, pt<br /> <br /> o.TextFill = True<br /> <br /> Dim xdataOut As Variant<br /> Dim xtypeOut As Variant<br /> o.GetXData "ACAD", xtypeOut, xdataOut<br /> If IsArray(xdataOut) Then<br /> Dim i As Long<br /> For i = LBound(xdataOut) To UBound(xdataOut)<br /> If xdataOut(i) = 69 Then<br /> xdataOut(i + 1) = 1<br /> Exit For<br /> End If<br /> Next<br /> End If<br /> o.SetXData xtypeOut, xdataOut<br /> End Sub

sicky111

学习一下。

HLCAD

回复，学习学习

zhuzhi1631

好贴

liulisheng

279491611

感谢分享！学习一下！