坐標標註程式，希望高手將PLINE和文字合併為單個坐標式標註，要求標註時文字能讓開。

ZHANGJIANZSY

坐標標註程式，
希望高手將PLINE和文字合併為單個坐標式標註，要求標註時文字能讓開。
或者說將PLINE和文字能夠在水平方向或豎直方向，移動文字時PLINE也能像坐標式標註一樣自動拉伸变长。

Gu_xl

1. ;;;使用反应器
   
2. ;将
   
3. (command "pline" d a ""
   
4. "text" b tt "90" (rtos c 2 aa))
   
5. ;;;修改为如下：
   
6. (progn
   
7. (command "pline" d a "")
   
8. (setq enpline (entlast))
   
9. (command "text" b tt "90" (rtos c 2 aa))
   
10. (setq enText (entlast))
    
11. ;;;添加反应器
    
12. (vlr-pers (VLR-Object-Reactor (list (vlax-ename->vla-object enText)) (list (cdr (assoc 5 (entget enpline)))) '((:VLR-modified . text-Change))))
    
13. )
    
14. 
    
15. ;;;回调函数
    
16. (defun text-Change (text-Object Reactor-Object Parameter-list / hand enpline)
    
17. (setq Hand (vlr-data Reactor-Object))
    
18.   (setq enpline (handent (car hand))
    
19. objPline (vlax-ename->vla-object enpline))
    
20.   (setq pt (cdr (assoc 10 (entget (setq entext (vlax-vla-object->ename text-Object)))))
    
21. Rot (cdr (assoc 50 (entget entext)))
    
22. pend (vlax-curve-getEndPoint enpline)
    
23. )
    
24. ;;;根据text的坐标计算pline端点坐标
    
25.   (cond ((equal rot 0 0.0001)
    
26.   (setq pt1 (polar pt pi (/ tt 2.0))
    
27.         pt1 (list (car pt1) (cadr pend))
    
28.     )
    
29.   )
    
30. ((equal rot (/ pi 2) 0.0001)
    
31.   (setq pt1 (polar pt (/ pi 2) (/ tt 2.0 -1))
    
32.         pt1 (list (car pend) (cadr pt1))
    
33.         )
    
34.   )
    
35. )
    
36. ;;;修改pline 端点坐标
    
37.   (vla-put-Coordinate objPline (vlax-curve-getEndParam objPline)
    
38.     (vlax-safearray-fill
    
39.       (vlax-make-safearray vlax-vbdouble '(0 . 1))
    
40.       pt1
    
41.    
    
42.   )
    
43.    
    
44.     )
    
45.   )
    

;;;使用反应器<br /> ;将<br /> (command "pline" d a ""<br /> "text" b tt "90" (rtos c 2 aa))<br /> ;;;修改为如下：<br /> (progn<br /> (command "pline" d a "")<br /> (setq enpline (entlast))<br /> (command "text" b tt "90" (rtos c 2 aa))<br /> (setq enText (entlast))<br /> ;;;添加反应器<br /> (vlr-pers (VLR-Object-Reactor (list (vlax-ename->vla-object enText)) (list (cdr (assoc 5 (entget enpline)))) '((:VLR-modified . text-Change))))<br /> )<br /> <br /> ;;;回调函数<br /> (defun text-Change (text-Object Reactor-Object Parameter-list / hand enpline)<br /> (setq Hand (vlr-data Reactor-Object))<br />   (setq enpline (handent (car hand))<br /> objPline (vlax-ename->vla-object enpline))<br />   (setq pt (cdr (assoc 10 (entget (setq entext (vlax-vla-object->ename text-Object)))))<br /> Rot (cdr (assoc 50 (entget entext)))<br /> pend (vlax-curve-getEndPoint enpline)<br /> )<br /> ;;;根据text的坐标计算pline端点坐标<br />   (cond ((equal rot 0 0.0001)<br />   (setq pt1 (polar pt pi (/ tt 2.0))<br />         pt1 (list (car pt1) (cadr pend))<br />     )<br />   )<br /> ((equal rot (/ pi 2) 0.0001)<br />   (setq pt1 (polar pt (/ pi 2) (/ tt 2.0 -1))<br />         pt1 (list (car pend) (cadr pt1))<br />         )<br />   )<br /> )<br /> ;;;修改pline 端点坐标<br />   (vla-put-Coordinate objPline (vlax-curve-getEndParam objPline)<br />     (vlax-safearray-fill<br />       (vlax-make-safearray vlax-vbdouble '(0 . 1))<br />       pt1<br />    <br />   )<br />     <br />     )<br />   )<br />

ZHANGJIANZSY

Gu_xl 发表于 2011-2-13 13:37

谢谢版主，在竖直方向PLINE可以随文字变化，
但水平方向文字让不开；
文字向水平方向移动后，PLINE不会变化

Gu_xl

回复 ZHANGJIANZSY 的帖子

自己修改下我的提示处：
";;;修改pline 端点坐标"
的代码！

ZHANGJIANZSY

回复 Gu_xl 的帖子

版主麻烦你帮我在SORDIM.LSP文件内修改。我不会用反应器，

pop159

修改后麻烦贴出，谢谢

songbf

看看，学习中