[求助][1208]将物件旋转到其指定的角度位置

eachy

自身中点旋转

2. 
   
3. (defun c:tt (/ p an ss sl i e el sp ep pmid sp1 ep1)
   
4.   (if (and (setq p (getpoint "\nCenter: "))
   
5.            (setq an (getangle p "\nAngle: "))
   
6.            (setq ss (ssget '((0 . "line"))))
   
7.       )
   
8.     (progn
   
9.       (setq sl (sslength ss)
   
10.             i  -1
    
11.       )
    
12.       (repeat sl
    
13.         (setq e           (ssname ss (setq i (1+ i)))
    
14.               el   (entget e)
    
15.               sp   (vlax-curve-getstartpoint e)
    
16.               ep   (vlax-curve-getendpoint e)
    
17.               pmid (polar sp (angle sp ep) (setq d (/ (distance sp ep) 2.)))
    
18.         )
    
19.         (setq sp1 (polar pmid an d)
    
20.               ep1 (polar pmid (+ an pi) d)
    
21.         )
    
22.         (setq el (subst (cons 10 sp1) (assoc 10 el) el)
    
23.               el (subst (cons 11 ep1) (assoc 11 el) el)
    
24.         )
    
25.         (entmod el)
    
26.       )
    
27.     )
    
28.   )
    
29.   (princ)
    
30. )

<br /> (defun c:tt (/ p an ss sl i e el sp ep pmid sp1 ep1)<br />   (if (and (setq p (getpoint "\nCenter: "))<br />            (setq an (getangle p "\nAngle: "))<br />            (setq ss (ssget '((0 . "line"))))<br />       )<br />     (progn<br />       (setq sl (sslength ss)<br />             i  -1<br />       )<br />       (repeat sl<br />         (setq e           (ssname ss (setq i (1+ i)))<br />               el   (entget e)<br />               sp   (vlax-curve-getstartpoint e)<br />               ep   (vlax-curve-getendpoint e)<br />               pmid (polar sp (angle sp ep) (setq d (/ (distance sp ep) 2.)))<br />         )<br />         (setq sp1 (polar pmid an d)<br />               ep1 (polar pmid (+ an pi) d)<br />         )<br />         (setq el (subst (cons 10 sp1) (assoc 10 el) el)<br />               el (subst (cons 11 ep1) (assoc 11 el) el)<br />         )<br />         (entmod el)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

xyp1964

按楼上的“自身中点旋转”就基本不移位了！

2. [FONT=courier new](defun c:ts ()
   
3.   (cmdla0)
   
4.   (setq        ANG (UANGLE 1 "" "\n角度" ANG nil)
   
5.         ss  (ssget '((0 . "LINE")))
   
6.         i   -1
   
7.   )
   
8.   (while (setq s1 (ssname ss (setq i (1+ i))))
   
9.     (setq ang1 (vla-get-Angle (vlax-ename->vla-object s1))
   
10.           pt   (xyp-get-MidPoint (xyp-get-DXF 10 s1) (xyp-get-DXF 11 s1))
    
11.           da   (rad2ang (- ang ang1))
    
12.     )
    
13.     (command "rotate" s1 "" pt da)
    
14.   )
    
15.   (cmdla1)
    
16. )[/FONT]

[FONT=courier new](defun c:ts ()<br />   (cmdla0)<br />   (setq        ANG (UANGLE 1 "" "\n角度" ANG nil)<br />         ss  (ssget '((0 . "LINE")))<br />         i   -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq ang1 (vla-get-Angle (vlax-ename->vla-object s1))<br />           pt   (xyp-get-MidPoint (xyp-get-DXF 10 s1) (xyp-get-DXF 11 s1))<br />           da   (rad2ang (- ang ang1))<br />     )<br />     (command "rotate" s1 "" pt da)<br />   )<br />   (cmdla1)<br /> )[/FONT]

狂刀

再改一下，支持ｕｃｓ；可两点定角度或直接输入角度值
[php]
(defun c:rang (/ ucsa an ss i e ps pm)
  (setq ucsa (angle '(0. 0. 0.) (getvar "ucsxdir")))
  (if (and (setq an (getangle "\n角度(可直接输入角度值): "))
           (setq ss (ssget '((0 . "line"))))
      )
    (progn
      (setq  i  -1)
      (repeat (sslength ss)
        (setq e         (ssname ss (setq i (1+ i)))
              ps (vlax-curve-getstartpoint e)
              pm (vlax-curve-getpointatparam e(/(vlax-curve-getendparam e)2))
        )
        (vla-rotate (vlax-ename->vla-object e)(vlax-3d-point pm) (- an (angle pm ps) (- ucsa)))
      )
    )
  )
  (princ)
)[/php]

robin6688138

学习一下