[LISP程序]：文字、对象对齐于某线段--你不再常常为标注管径、坡度时不能与线段对齐烦

libo2000

2. ;;;文字、对象对齐于某线段
   
3. (defun c:cheng_align( / e0 ss p0 p1 p2 p3 p4 r r0 m w x1 x2 y1 y2 x3 y3 x4 y4 c old_osmode tmp)
   
4.   (princ "文字、对象对齐于某线段 cheng_align by CHENG")
   
5.   (setq old_osmode (getvar "osmode"))
   
6.   (setq tmp T)
   
7.   (while (/= tmp "TEXT")
   
8.     (setq e0 (entsel "\n选择一个文字对象:"))   
   
9.     (if e0 (setq tmp (cdr (assoc 0 (entget (car e0))))) (setq tmp "TEXT"))   
   
10.   )
    
11.   (if e0
    
12.     (progn
    
13.       (princ "\n选择其他对象：")
    
14.       (setq ss (ssget))
    
15.       (if (= ss nil) (setq ss (ssadd)))
    
16.       (ssadd (cdr (assoc -1 (entget (car e0)))) ss)
    
17.       (setvar "osmode" 951)
    
18.       (setq p1 (getpoint "\n选择第一对齐点："))
    
19.       (setq p2 (getpoint "\n选择第二对齐点："))      
    
20.       (if (= cheng_align_m nil) (setq cheng_align_m (/ (cdr (assoc 40 (entget (car e0)))) 3.5)))
    
21.       (princ "\n对齐偏移量<") (princ cheng_align_m) (princ ">:")
    
22.       (setq m (getreal))
    
23.       (setq tmp2 nil)
    
24.       (setq tmp2 (getstring "\n删除旧对象？<Y>"))
    
25.       (if (or (= tmp2 "Y") (= tmp2 "") (= tmp2 "y") (= tmp2 nil)) (setq tmp2 "Y") (setq tmp2 nil))
    
26.       (if (/= m nil) (setq cheng_align_m m))
    
27.       (setq m cheng_align_m)
    
28.       (setq r (angle p1 p2))
    
29.       (setq w (cdr (assoc 40 (entget (car e0)))))
    
30.       (setq p0 (cdr (assoc 10 (entget (car e0)))))      
    
31.       (setq x0 (car p0))
    
32.       (setq y0 (car(cdr p0)))
    
33.       (setq x1 (car p1))
    
34.       (setq y1 (car(cdr p1)))
    
35.       (setq x2 (car p2))
    
36.       (setq y2 (car(cdr p2)))
    
37.       (setq r0 (cdr (assoc 50 (entget (car e0)))))               
    
38.       (setq r0 (* (/ 180.0 pi) r0))
    
39.       (setq r0 (- (* (/ 180.0 pi) r) r0))
    
40.       (setq c (sqrt (+ (* (- x2 x1) (- x2 x1)) (* (- y2 y1) (- y2 y1)))))
    
41.       (setq x3 (+ x0 (* c (sin r))))
    
42.       (setq y3 (+ y0 (* c (cos r))))
    
43.       (setq p3 (list x3 y3 0.0))
    
44.       (setq x4 (- x1 (* m (sin r))))
    
45.       (setq y4 (+ y1 (* m (cos r))))
    
46.       (if (> x1 x2)
    
47.         (progn
    
48.           (setq r0 (+ r0 180))
    
49.           (setq m (+ cheng_align_m w))         
    
50.           (setq x4 (- x2 (* m (sin r))))
    
51.           (setq y4 (+ y2 (* m (cos r))))
    
52.         )
    
53.       )
    
54.       (setq p4 (list x4 y4 0.0))
    
55.       (setq i 0)
    
56.       (if (/= tmp2 "Y") (command "copy" ss "" p0 p0))
    
57.       ;(repeat (sslength ss)
    
58.        ; (setq e0 (ssname ss i))
    
59.        ; (setq i (+ i 1))
    
60.         (command "ROTATE" ss "" p0 r0)
    
61.       ;)
    
62.       (command "move" ss "" p0 p4)
    
63.       (setvar "osmode" old_osmode)
    
64.     )
    
65.   )
    
66.   (princ)
    
67. );end cheng_align
    
68. 
    
69. ;;;使用方法：
    
70. ;;;1。必须先选择一个文字对象(e0)，再选择其他对象（可不选）
    
71. ;;;2。选择第一对齐点(p1)
    
72. ;;;3。选择第一对齐点(p2)
    
73. ;;;4。输入对齐偏移量(m)
    
74. ;;;如果p1的x坐标<=p2的x坐标，那么文字e0将以p1为基点在p1,p2连线的上方；
    
75. ;;;反之，如果p1的x坐标>p2的x坐标，那么文字e0将以p2为基点在p1,p2连线的下方；

;;;文字、对象对齐于某线段<br /> (defun c:cheng_align( / e0 ss p0 p1 p2 p3 p4 r r0 m w x1 x2 y1 y2 x3 y3 x4 y4 c old_osmode tmp)<br />   (princ "文字、对象对齐于某线段 cheng_align by CHENG")<br />   (setq old_osmode (getvar "osmode"))<br />   (setq tmp T)<br />   (while (/= tmp "TEXT")<br />     (setq e0 (entsel "\n选择一个文字对象:"))    <br />     (if e0 (setq tmp (cdr (assoc 0 (entget (car e0))))) (setq tmp "TEXT"))   <br />   )<br />   (if e0<br />     (progn<br />       (princ "\n选择其他对象：")<br />       (setq ss (ssget))<br />       (if (= ss nil) (setq ss (ssadd)))<br />       (ssadd (cdr (assoc -1 (entget (car e0)))) ss)<br />       (setvar "osmode" 951)<br />       (setq p1 (getpoint "\n选择第一对齐点："))<br />       (setq p2 (getpoint "\n选择第二对齐点："))      <br />       (if (= cheng_align_m nil) (setq cheng_align_m (/ (cdr (assoc 40 (entget (car e0)))) 3.5)))<br />       (princ "\n对齐偏移量<") (princ cheng_align_m) (princ ">:")<br />       (setq m (getreal))<br />       (setq tmp2 nil)<br />       (setq tmp2 (getstring "\n删除旧对象？<Y>"))<br />       (if (or (= tmp2 "Y") (= tmp2 "") (= tmp2 "y") (= tmp2 nil)) (setq tmp2 "Y") (setq tmp2 nil))<br />       (if (/= m nil) (setq cheng_align_m m))<br />       (setq m cheng_align_m)<br />       (setq r (angle p1 p2))<br />       (setq w (cdr (assoc 40 (entget (car e0)))))<br />       (setq p0 (cdr (assoc 10 (entget (car e0)))))      <br />       (setq x0 (car p0))<br />       (setq y0 (car(cdr p0)))<br />       (setq x1 (car p1))<br />       (setq y1 (car(cdr p1)))<br />       (setq x2 (car p2))<br />       (setq y2 (car(cdr p2)))<br />       (setq r0 (cdr (assoc 50 (entget (car e0)))))               <br />       (setq r0 (* (/ 180.0 pi) r0))<br />       (setq r0 (- (* (/ 180.0 pi) r) r0))<br />       (setq c (sqrt (+ (* (- x2 x1) (- x2 x1)) (* (- y2 y1) (- y2 y1)))))<br />       (setq x3 (+ x0 (* c (sin r))))<br />       (setq y3 (+ y0 (* c (cos r))))<br />       (setq p3 (list x3 y3 0.0))<br />       (setq x4 (- x1 (* m (sin r))))<br />       (setq y4 (+ y1 (* m (cos r))))<br />       (if (> x1 x2) <br />         (progn<br />           (setq r0 (+ r0 180))<br />           (setq m (+ cheng_align_m w))         <br />           (setq x4 (- x2 (* m (sin r))))<br />           (setq y4 (+ y2 (* m (cos r))))<br />         )<br />       )<br />       (setq p4 (list x4 y4 0.0))<br />       (setq i 0)<br />       (if (/= tmp2 "Y") (command "copy" ss "" p0 p0))<br />       ;(repeat (sslength ss)<br />        ; (setq e0 (ssname ss i))<br />        ; (setq i (+ i 1))<br />         (command "ROTATE" ss "" p0 r0)<br />       ;)<br />       (command "move" ss "" p0 p4)<br />       (setvar "osmode" old_osmode)<br />     )<br />   )<br />   (princ)<br /> );end cheng_align<br /> <br /> ;;;使用方法：<br /> ;;;1。必须先选择一个文字对象(e0)，再选择其他对象（可不选）<br /> ;;;2。选择第一对齐点(p1)<br /> ;;;3。选择第一对齐点(p2)<br /> ;;;4。输入对齐偏移量(m)<br /> ;;;如果p1的x坐标<=p2的x坐标，那么文字e0将以p1为基点在p1,p2连线的上方；<br /> ;;;反之，如果p1的x坐标>p2的x坐标，那么文字e0将以p2为基点在p1,p2连线的下方；

mmmm

直接用align命令不是更简单？

ydf7332462

选对齐对象时应单选,不然应用align

libo2000

问题就是align 对于文字太难捕捉2个点了，所以才搞这个东东。

ydf7332462

对齐某线段,点p1就够了,请省去p2，自行判断
偏移量正值在上，负值在下

liuyj

还是这个好，可对文字、图块操作，单击就行了。很方便

;;;    This program will match text angle to a line angle selected
;;;--------------------------------------------------------------------
(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 )
(setvar "cmdecho" 1)

;finds the angle of the line
  (setq wait "T")
  (while wait
   (setq time "T")
   (while time
    (setq sl (entsel "\n Pick Angle To Match:"))
    (if (/= sl nil)(setq time nil))
   )
   (setq l1 (entget (car sl)))
   (setq enttyp (cdr (assoc 0 l1)))
   (if (= enttyp "LINE")(setq wait nil))
  )
  (setq p1 (cdr (assoc 10 l1)))
  (setq x1 (car p1))
  (setq p2 (cdr (assoc 11 l1)))
  (setq x2 (car p2))

(setq why (angle p1 p2))
        (if (>= why 0)
          (setq ang1 why)
        )
        (if (> why 1.5708);same as 90?
          (setq ang1 (+ 3.14159 why));add 180?
        )
        (if (>= why 4.71413);same as 270.1?
          (setq ang1 why)
        )

;finds angle of txt
  (setq wait2 "T")
  (while wait2
   (setq time2 "T")
   (while time2
    (setq st (entsel "\n Pick Text Or Block To Change:"))
    (if (/= st nil)(setq time2 nil))
   )
   (setq tx1 (entget (car st)))
   (setq enttyp2 (cdr (assoc 0 tx1)))
   (if (or(= enttyp2 "TEXT")(= enttyp2 "INSERT")(= enttyp2 "ATTDEF"))(setq wait2 nil))
  )
  (setq ang2 (cdr (assoc 50 tx1)))
  (setq oang (cons 50 ang2))
  (setq nang (cons 50 ang1))
  (setq tx1 (subst nang oang tx1))
  (entmod tx1)
  (terpri)
  (setq bob "T")
  (while bob
   (initget 6 "M m")
   (setq getit (getkword "\n Press M to rotate 180?or <ENTER> to quit "))
   (if (or (= getit "m") (= getit "M"))
       (progn
        (setq oang (assoc 50 tx1))
        (setq oangprt (cdr oang))
        (setq nang (cons 50 (+ 3.14159 oangprt)))
        (setq tx1 (subst nang oang tx1))
        (entmod tx1)
       )
       (setq bob nil)
   )
  )

  (setvar "cmdecho" 0)
  (princ)
)