沿曲线上两点移动对象

自贡黄明儒

1. ;;;[功能]沿曲线移动 Move by curve=============================================
   
2. (defun C:Mee (/ ANG ANG1 ANG2 D0 D1 D2 DIS E0 P1 P2 SS)
   
3.   ;;(alert "沿曲线移动对象：\n 沿曲线上两点移动")
   
4.   (if (and
   
5.         (setq ss (LM:ssget "\n >移动对象:" '(((0 . "*")))))
   
6.         (setq e0 (Fsxm-entsel "\n >>选择曲线:"
   
7.                               '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))
   
8.                  )
   
9.         )
   
10.         (setq p1 (getpoint "\n >>>移动基点:"))
    
11.         (setq p2 (getpoint "\n >>>移动到:"))
    
12.       )
    
13.     (progn
    
14.       (setq e0 (car e0))
    
15.       (setq p1 (vlax-curve-getclosestpointto e0 p1))
    
16.       (setq p2 (vlax-curve-getclosestpointto e0 p2))
    
17.       (setq d0        (- (vlax-curve-getDistAtPoint e0 p2)
    
18.                    (vlax-curve-getDistAtPoint e0 p1)
    
19.                 )
    
20.       )
    
21.       (setq dis (getreal (strcat "\n 移动距离<" (VL-PRINC-TO-STRING d0) ">:")))
    
22.       (if (not dis)
    
23.         (setq dis d0)
    
24.         ;;输入dis后，计算新p2
    
25.         (progn          
    
26.           (setq d1 (vlax-curve-getDistAtPoint e0 p1))
    
27.           (setq d2 (+ d1 dis))          
    
28.           (setq p2(vlax-curve-getPointAtDist e0 d2))
    
29.         )
    
30.       )
    
31. 
    
32.      (setq ang1 (vlax-curve-getParamAtPoint e0 p1))
    
33.      (setq ang1 (vlax-curve-getFirstDeriv e0 ang1))
    
34.      (setq ang1 (angle ang1 '(0 0 0)))
    
35.      (setq ang2 (vlax-curve-getParamAtPoint e0 p2))
    
36.      (setq ang2 (vlax-curve-getFirstDeriv e0 ang2))
    
37.      (setq ang2 (angle ang2 '(0 0 0)))
    
38.      (setq ang (/ (* (- ang2 ang1) 180) pi))     
    
39.       (ACET-UNDO-BEGIN)
    
40.       (vl-cmdf "_.move" ss "" "non" p1 "non" p2)
    
41.       (vl-cmdf "._rotate" ss "" "non" p2 ang)
    
42.       (ACET-UNDO-END)
    
43.     )
    
44.   )
    
45.   (princ "\n沿曲线上两点移动对象 Mee")
    
46.   (princ)
    
47. )
    
48. (princ "\n 沿曲线上两点移动对象 Mee")
    
49. (princ)
    
50. ;;;[功能]沿曲线移动 Move by curve=============================================

;;;[功能]沿曲线移动 Move by curve=============================================<br /> (defun C:Mee (/ ANG ANG1 ANG2 D0 D1 D2 DIS E0 P1 P2 SS)<br />   ;;(alert "沿曲线移动对象：\n 沿曲线上两点移动")<br />   (if (and<br />         (setq ss (LM:ssget "\n >移动对象:" '(((0 . "*")))))<br />         (setq e0 (Fsxm-entsel "\n >>选择曲线:"<br />                               '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))<br />                  )<br />         )<br />         (setq p1 (getpoint "\n >>>移动基点:"))<br />         (setq p2 (getpoint "\n >>>移动到:"))<br />       )<br />     (progn<br />       (setq e0 (car e0))<br />       (setq p1 (vlax-curve-getclosestpointto e0 p1))<br />       (setq p2 (vlax-curve-getclosestpointto e0 p2))<br />       (setq d0        (- (vlax-curve-getDistAtPoint e0 p2)<br />                    (vlax-curve-getDistAtPoint e0 p1)<br />                 )<br />       )<br />       (setq dis (getreal (strcat "\n 移动距离<" (VL-PRINC-TO-STRING d0) ">:")))<br />       (if (not dis)<br />         (setq dis d0)<br />         ;;输入dis后，计算新p2<br />         (progn          <br />           (setq d1 (vlax-curve-getDistAtPoint e0 p1))<br />           (setq d2 (+ d1 dis))          <br />           (setq p2(vlax-curve-getPointAtDist e0 d2))<br />         )<br />       )<br /> <br />      (setq ang1 (vlax-curve-getParamAtPoint e0 p1))<br />      (setq ang1 (vlax-curve-getFirstDeriv e0 ang1))<br />      (setq ang1 (angle ang1 '(0 0 0)))<br />      (setq ang2 (vlax-curve-getParamAtPoint e0 p2))<br />      (setq ang2 (vlax-curve-getFirstDeriv e0 ang2))<br />      (setq ang2 (angle ang2 '(0 0 0)))<br />      (setq ang (/ (* (- ang2 ang1) 180) pi))     <br />       (ACET-UNDO-BEGIN)<br />       (vl-cmdf "_.move" ss "" "non" p1 "non" p2)<br />       (vl-cmdf "._rotate" ss "" "non" p2 ang)<br />       (ACET-UNDO-END)<br />     )<br />   )<br />   (princ "\n沿曲线上两点移动对象 Mee")<br />   (princ)<br /> )<br /> (princ "\n 沿曲线上两点移动对象 Mee")<br /> (princ)<br /> ;;;[功能]沿曲线移动 Move by curve=============================================

panliang9

似乎是把一个对象从曲线的一点移动到另一点，移到终点后还根据曲线的位置改变对象的方向。

love1030312

no function definition: LM:SSGET   缺少的函数在哪里呢

dd131028

运行不起来，命令能输入，但会提示函数取消。

xyp1964

沿曲线移动实体