[LISP程序]：文字、图块与直线对齐

liuyj

可将文字和图块与选定直线对齐,M键可以180°旋转。可不可以给加一分?搞这个东西可不容易啊!

2. 
   
3.   [FONT=courier new]
   
4. ;;; This program will match text angle to a line angle selected
   
5. ;;;--------------------------------------------------------------------
   
6. (defun c:ta ( / ang1 ang2 bob enttyp enttyp2 getit l1 nang oang oangprt p1 p2 sl st time time2 tx1 wait wait2 why x1 x2 )
   
7. (setvar "cmdecho" 1)
   
8. 
   
9. ;finds the angle of the line
   
10. (setq wait "T")
    
11. (while wait
    
12. (setq time "T")
    
13. (while time
    
14. (setq sl (entsel "\n Pick Angle To Match:"))
    
15. (if (/= sl nil)(setq time nil))
    
16. )
    
17. (setq l1 (entget (car sl)))
    
18. (setq enttyp (cdr (assoc 0 l1)))
    
19. (if (= enttyp "LINE")(setq wait nil))
    
20. )
    
21. (setq p1 (cdr (assoc 10 l1)))
    
22. (setq x1 (car p1))
    
23. (setq p2 (cdr (assoc 11 l1)))
    
24. (setq x2 (car p2))
    
25. 
    
26. (setq why (angle p1 p2))
    
27. (if (>= why 0)
    
28. (setq ang1 why)
    
29. )
    
30. (if (> why 1.5708);same as 90?
    
31. (setq ang1 (+ 3.14159 why));add 180?
    
32. )
    
33. (if (>= why 4.71413);same as 270.1?
    
34. (setq ang1 why)
    
35. )
    
36. 
    
37. ;finds angle of txt
    
38. (setq wait2 "T")
    
39. (while wait2
    
40. (setq time2 "T")
    
41. (while time2
    
42. (setq st (entsel "\n Pick Text Or Block To Change:"))
    
43. (if (/= st nil)(setq time2 nil))
    
44. )
    
45. (setq tx1 (entget (car st)))
    
46. (setq enttyp2 (cdr (assoc 0 tx1)))
    
47. (if (or(= enttyp2 "TEXT")(= enttyp2 "INSERT")(= enttyp2 "ATTDEF"))(setq wait2 nil))
    
48. )
    
49. (setq ang2 (cdr (assoc 50 tx1)))
    
50. (setq oang (cons 50 ang2))
    
51. (setq nang (cons 50 ang1))
    
52. (setq tx1 (subst nang oang tx1))
    
53. (entmod tx1)
    
54. (terpri)
    
55. (setq bob "T")
    
56. (while bob
    
57. (initget 6 "M m")
    
58. (setq getit (getkword "\n Press M to rotate 180?or to quit "))
    
59. (if (or (= getit "m") (= getit "M"))
    
60. (progn
    
61. (setq oang (assoc 50 tx1))
    
62. (setq oangprt (cdr oang))
    
63. (setq nang (cons 50 (+ 3.14159 oangprt)))
    
64. (setq tx1 (subst nang oang tx1))
    
65. (entmod tx1)
    
66. )
    
67. (setq bob nil)
    
68. )
    
69. )
    
70. 
    
71. (setvar "cmdecho" 0)
    
72. (princ)
    
73. )
    
74. 
    
75.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;; This program will match text angle to a line angle selected<br /> ;;;--------------------------------------------------------------------<br /> (defun c:ta ( / ang1 ang2 bob enttyp enttyp2 getit l1 nang oang oangprt p1 p2 sl st time time2 tx1 wait wait2 why x1 x2 )<br /> (setvar "cmdecho" 1)<br /> <br /> ;finds the angle of the line<br /> (setq wait "T")<br /> (while wait<br /> (setq time "T")<br /> (while time<br /> (setq sl (entsel "\n Pick Angle To Match:"))<br /> (if (/= sl nil)(setq time nil))<br /> )<br /> (setq l1 (entget (car sl)))<br /> (setq enttyp (cdr (assoc 0 l1)))<br /> (if (= enttyp "LINE")(setq wait nil))<br /> )<br /> (setq p1 (cdr (assoc 10 l1)))<br /> (setq x1 (car p1))<br /> (setq p2 (cdr (assoc 11 l1)))<br /> (setq x2 (car p2))<br /> <br /> (setq why (angle p1 p2))<br /> (if (>= why 0)<br /> (setq ang1 why)<br /> )<br /> (if (> why 1.5708);same as 90?<br /> (setq ang1 (+ 3.14159 why));add 180?<br /> )<br /> (if (>= why 4.71413);same as 270.1?<br /> (setq ang1 why)<br /> )<br /> <br /> ;finds angle of txt<br /> (setq wait2 "T")<br /> (while wait2<br /> (setq time2 "T")<br /> (while time2<br /> (setq st (entsel "\n Pick Text Or Block To Change:"))<br /> (if (/= st nil)(setq time2 nil))<br /> )<br /> (setq tx1 (entget (car st)))<br /> (setq enttyp2 (cdr (assoc 0 tx1)))<br /> (if (or(= enttyp2 "TEXT")(= enttyp2 "INSERT")(= enttyp2 "ATTDEF"))(setq wait2 nil))<br /> )<br /> (setq ang2 (cdr (assoc 50 tx1)))<br /> (setq oang (cons 50 ang2))<br /> (setq nang (cons 50 ang1))<br /> (setq tx1 (subst nang oang tx1))<br /> (entmod tx1)<br /> (terpri)<br /> (setq bob "T")<br /> (while bob<br /> (initget 6 "M m")<br /> (setq getit (getkword "\n Press M to rotate 180?or to quit "))<br /> (if (or (= getit "m") (= getit "M"))<br /> (progn<br /> (setq oang (assoc 50 tx1))<br /> (setq oangprt (cdr oang))<br /> (setq nang (cons 50 (+ 3.14159 oangprt)))<br /> (setq tx1 (subst nang oang tx1))<br /> (entmod tx1)<br /> )<br /> (setq bob nil)<br /> )<br /> )<br /> <br /> (setvar "cmdecho" 0)<br /> (princ)<br /> )<br /> <br />   [/FONT]<br />

sunshinejwt

下载后试试，在做评论

路与三年

最好弄个演示怎么用的，大家看明白了加分就容易了！

xdcad9819

感谢楼主分享 好资料 收藏 谢谢