[讨论][求教cad编程问题

feixue800

我画了一条斜线， 线上面有平行的文字。我如果想把线左端不动右端改到另一个点（线长短和都角度改变了）而文字始终位于线正中且平行于该线，应该怎么编代码呢？

谢谢~~

ZZXXQQ

1、先选文字；

2、再选线条；

3、计算线条中点和倾斜角；

4、将文字移动到指定点，并旋转到指定角度。

 

killer9806

要用反应器来弄.

masterlong

想做的完美

肯定是要用到反应器的

如果楼主对反应器不熟又赶时间的话

先按ZZXXQQ的方法做比较简单

 

2楼有点小问题

没有考虑文字节点的因素

选文字以后要计算出文字包围盒的中心

或者将文字节点模式改成“中”、“中心”等

这样移动以后才能保证在线的正中

 

另外直线端点在改变以后

如果左端变成了右端

那么文字的位置和角度

要相对线中心转个180度

feixue800

这里果然高手如云啊，小弟对反应器是一窍不通啊，哪位高手能帮小弟写个代码呢？不胜感激啊~~~

masterlong

如果对反应器不熟就不要轻易在程序里使用

转个贴你看看

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=46996&replyID=&skin=0

piao1887

2. (defun c:xz ()
3. (setq osmode (getvar "osmode"))
4. (setvar "osmode" 0)
5. (setq enttxt (car (entsel "\n请选择文字")))
6. (if (not enttxt)
7. (exit)
8. )
9. (setq xx (cdr (assoc 0 (entget enttxt))))
10. (while (/= xx "TEXT")
11. (setq enttxt (car (entsel "\n请选择文字")))
12. (if    (not enttxt)
13. (exit)
14. )
15. (setq xx (cdr (assoc 0 (entget enttxt))))
16. )
17. (setq ent (entget enttxt))
18. (setq entLINE (car (entsel "\n请选择直线")))
19. (if (not entline)
20. (exit)
21. )
22. (setq xx (cdr (assoc 0 (entget entline))))
23. (while (/= xx "LINE")
24. (setq entLINE (car (entsel "\n请选择直线")))
25. (if    (not entline)
26. (exit)
27. )
28. (setq xx (cdr (assoc 0 (entget entline))))
29. )
30. (setq myline (entget entline))
31. (setq mytxt (entget enttxt))
32. (VLR-PERS-RELEASE            ;线对象反应器
33. (vlr-object-reactor
34. (list (vlax-ename->vla-object entline))
35. (list (cdr (assoc 5 mytxt)))
36. '((:vlr-modified . line-chang)
37.     (:vlr-objectClosed . line-end-chang)
38. )
39. )
40. )
41. )
42. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
43. (defun line-chang (obj rec-object par-list / entline enttxt)
44. (setq    entline    (vlax-vla-object->ename obj)
45.     enttxt    (handent (car (vlr-data rec-object)))
46. )
47. (setq ent (entget enttxt))
48. (setq spt (cdr (assoc 10 (entget entline))))
49. (setq ept (cdr (assoc 11 (entget entline))))
50. (setq ang (angle spt ept))
51. (setq ent (subst (cons 50 ang) (assoc 50 ent) ent))
52. (entmod ent)
53. )
54. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
55. (defun line-end-chang (obj rec-object par-list /)
56. (setq    entline    (vlax-vla-object->ename obj)
57.     enttxt    (handent (car (vlr-data rec-object)))
58. )
59. (setq ent (entget enttxt))
60. (setq spt (cdr (assoc 10 (entget entline))))
61. (setq ept (cdr (assoc 11 (entget entline))))
62. (setq    spty (nth 0 spt)
63.     sptx (nth 1 spt)
64.     epty (nth 0 ept)
65.     eptx (nth 1 ept)
66. )
67. (setq    midx (/ (+ sptx eptx) 2)
68.     midy (/ (+ spty epty) 2)
69. )
70. (setq enttxt1 (vlax-ename->vla-object enttxt))
71. (vla-put-InsertionPoint
72. enttxt1
73. (vlax-3d-point (list midy midx 0))
74. )
75. (princ)
76. )

(defun c:xz () (setq osmode (getvar "osmode")) (setvar "osmode" 0) (setq enttxt (car (entsel "\n请选择文字"))) (if (not enttxt) (exit) ) (setq xx (cdr (assoc 0 (entget enttxt)))) (while (/= xx "TEXT") (setq enttxt (car (entsel "\n请选择文字"))) (if    (not enttxt) (exit) ) (setq xx (cdr (assoc 0 (entget enttxt)))) ) (setq ent (entget enttxt)) (setq entLINE (car (entsel "\n请选择直线"))) (if (not entline) (exit) ) (setq xx (cdr (assoc 0 (entget entline)))) (while (/= xx "LINE") (setq entLINE (car (entsel "\n请选择直线"))) (if    (not entline) (exit) ) (setq xx (cdr (assoc 0 (entget entline)))) ) (setq myline (entget entline)) (setq mytxt (entget enttxt)) (VLR-PERS-RELEASE            ;线对象反应器 (vlr-object-reactor (list (vlax-ename->vla-object entline)) (list (cdr (assoc 5 mytxt))) '((:vlr-modified . line-chang)     (:vlr-objectClosed . line-end-chang) ) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun line-chang (obj rec-object par-list / entline enttxt) (setq    entline    (vlax-vla-object->ename obj)     enttxt    (handent (car (vlr-data rec-object))) ) (setq ent (entget enttxt)) (setq spt (cdr (assoc 10 (entget entline)))) (setq ept (cdr (assoc 11 (entget entline)))) (setq ang (angle spt ept)) (setq ent (subst (cons 50 ang) (assoc 50 ent) ent)) (entmod ent) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun line-end-chang (obj rec-object par-list /) (setq    entline    (vlax-vla-object->ename obj)     enttxt    (handent (car (vlr-data rec-object))) ) (setq ent (entget enttxt)) (setq spt (cdr (assoc 10 (entget entline)))) (setq ept (cdr (assoc 11 (entget entline)))) (setq    spty (nth 0 spt)     sptx (nth 1 spt)     epty (nth 0 ept)     eptx (nth 1 ept) ) (setq    midx (/ (+ sptx eptx) 2)     midy (/ (+ spty epty) 2) ) (setq enttxt1 (vlax-ename->vla-object enttxt)) (vla-put-InsertionPoint enttxt1 (vlax-3d-point (list midy midx 0)) ) (princ) )

先运行命令关联直线和文字
然后拖动直线 文字会跟着修改

feixue800

感谢piao1887