（完成）[编程申请]：求一个能自动标注块名的LSP。

曼漫

我是做园林工作的，要在图中标注全部树种的名称和数量。想要求一个类似引线标注这样的东西，希望引线写出来的文字就直接是我使用的块名，文字最好是单行文字。
先谢谢啦。*-*1

eachy

最初由 曼漫 发布
[B]我是做园林工作的，要在图中标注全部树种的名称和数量。想要求一个类似引线标注这样的东西，希望引线写出来的文字就直接是我使用的块名，文字最好是单行文字。
先谢谢啦。*-*1 [/B]

贴个样图，说明需要哪些点。

曼漫

每一个块都已经以树种名为块名

曼漫

引线标注最好能自动提取块名

eachy

2. 
   
3. (defun c:TName (/ tf e p thisdrawing mtext lea)
   
4.   (setq tf t)
   
5.   (while tf
   
6.     (if
   
7.       (and (setq e (entsel "\n选择树木: "))
   
8.            (or (= (cdr (assoc 0 (setq el (entget (car e))))) "INSERT")
   
9.                (= (cdr (assoc 0 el)) "HATCH")
   
10.            )
    
11.            (setq p (getpoint (last e) "\n标注点: "))
    
12.       )
    
13.        (progn
    
14.          (if (not thisdrawing)
    
15.            (setq thisdrawing
    
16.                   (vlax-get-property
    
17.                     (vlax-get-property
    
18.                       (vlax-get-acad-object)
    
19.                       'activedocument
    
20.                     )
    
21.                     'modelspace
    
22.                   )
    
23. 
    
24.            )
    
25.          )
    
26.          (setq mtext (vla-addmtext
    
27.                        thisdrawing
    
28.                        (vlax-3d-point (trans p 1 0))
    
29.                        0.
    
30.                        (cdr (assoc 2 el))
    
31.                      )
    
32.          )
    
33.          (setq lea (vla-addleader
    
34.                      thisdrawing
    
35.                      (vlax-make-variant
    
36.                        (vlax-safearray-fill
    
37.                          (vlax-make-safearray vlax-vbdouble '(0 . 5))
    
38.                          (append (trans (last e) 1 0) (trans p 1 0))
    
39.                        )
    
40.                      )
    
41.                      mtext
    
42.                      aclinewitharrow
    
43.                    )
    
44.          )
    
45.          (vla-put-arrowheadblock lea "_DOT")
    
46.        )                                ;end progn
    
47.        (setq tf nil)
    
48.     )                                        ;end if
    
49.   )                                        ;end while
    
50.   (princ)
    
51. )

<br /> (defun c:TName (/ tf e p thisdrawing mtext lea)<br />   (setq tf t)<br />   (while tf<br />     (if<br />       (and (setq e (entsel "\n选择树木: "))<br />            (or (= (cdr (assoc 0 (setq el (entget (car e))))) "INSERT")<br />                (= (cdr (assoc 0 el)) "HATCH")<br />            )<br />            (setq p (getpoint (last e) "\n标注点: "))<br />       )<br />        (progn<br />          (if (not thisdrawing)<br />            (setq thisdrawing<br />                   (vlax-get-property<br />                     (vlax-get-property<br />                       (vlax-get-acad-object)<br />                       'activedocument<br />                     )<br />                     'modelspace<br />                   )<br /> <br />            )<br />          )<br />          (setq mtext (vla-addmtext<br />                        thisdrawing<br />                        (vlax-3d-point (trans p 1 0))<br />                        0.<br />                        (cdr (assoc 2 el))<br />                      )<br />          )<br />          (setq lea (vla-addleader<br />                      thisdrawing<br />                      (vlax-make-variant<br />                        (vlax-safearray-fill<br />                          (vlax-make-safearray vlax-vbdouble '(0 . 5))<br />                          (append (trans (last e) 1 0) (trans p 1 0))<br />                        )<br />                      )<br />                      mtext<br />                      aclinewitharrow<br />                    )<br />          )<br />          (vla-put-arrowheadblock lea "_DOT")<br />        )                                ;end progn<br />        (setq tf nil)<br />     )                                        ;end if<br />   )                                        ;end while<br />   (princ)<br /> )

曼漫

YEAH！！就是这样，真是谢谢啊！
如果能加上一个圆点，另外字可以由MTEXT变为TEXT就更好了。。。
另外再问一下啊，对于填充图案也这样表示是不是比较困难呢？

eachy

最初由 曼漫 发布
[B]YEAH！！就是这样，真是谢谢啊！
如果能加上一个圆点，另外字可以由MTEXT变为TEXT就更好了。。。
另外再问一下啊，对于填充图案也这样表示是不是比较困难呢？ [/B]

填充图案你要标注什么呢？

寒梅

估计他的图案要标注灌木？
对这个程序想再提出一些附加要求，能不能将选中的同一种苗木自动连线并标出名称和数量？，添加的圆点能标注在块的基点上吗（前提是块的基点在中心），能给文字大小及点的设置吗（能设置标注比例更好）？

misdi

eachy兄真是热心人，我没事总是到这逛逛。

eachy

最初由 寒梅 发布
[B]估计他的图案要标注灌木？
对这个程序想再提出一些附加要求，能不能将选中的同一种苗木自动连线并标出名称和数量？，添加的圆点能标注在块的基点上吗（前提是块的基点在中心），能给文字大小及点的设置吗（能设置标... [/B]

请附详细图示

曼漫

最初由 寒梅 发布
[B]估计他的图案要标注灌木？
对这个程序想再提出一些附加要求，能不能将选中的同一种苗木自动连线并标出名称和数量？，添加的圆点能标注在块的基点上吗（前提是块的基点在中心），能给文字大小及点的设置吗（能设置标... [/B]

是啊是啊，填充是灌木~~我基本同意寒梅的意见
我的灌木填充图案都是已经使用了工具面板，不知道这样能不能提取属性。。。对于苗木连线可能比较麻烦，因为我这里的画图方式都不用连线的，因为有时候某种树木用很多的，位置非常的散乱，连线估计图面上都看不清楚了。字体和点的大小如果是根据图面正在使用的的标注样式的就OK的了

现在有一个问题，看能不能一并解决：标注的时候能不能按照当前坐标系来标注啊？刚才我调整了一个用户坐标系，然后标注的时候，都不懂那个字飞到什么地方去了。后来只是转UCS，标注的时候发现它是按照世界坐标系来标注的，线啊、字啊都是歪的

eachy

最初由 曼漫 发布
[B][QUOTE]最初由 寒梅 发布
[B]估计他的图案要标注灌木？
对这个程序想再提出一些附加要求，能不能将选中的同一种苗木自动连线并标出名称和数量？，添加的圆点能标注在块的基点上吗（前提是块的基点在中心）?.. [/B]

提取图案名称可以，但要标注面积的话也可以做到，前提是Hatch必须是一个环内的（可以有孤岛）分离的不行。

楼上帖子已更新，支持 Hatch 标注

曼漫

嗯，是啊，由于我们要计算面积数量，一般填充的时候都是先要做一个闭合线框，才好填数量。并不是直接点选填充的。

寒梅

ea动作好快，现在下班了，晚上再来试试。
再提个建议，能不能和上次统计苗木的程序有所关联，这样标注好后可以自动生成苗木表？

andyhua5240

斑竹的程序好是好，要是标注的文字大一点就更好了。文字的高度一般是300就OK了！
谢谢！