;物体沿曲线移动

Gray-wolf

;物体沿曲线移动
(defun c:TT (/ en re)
    (princ "\n选择移动物体: ")
    (setq ss (ssget ":S"))
    (setq pt (getpoint "\n选择移动基准点："))
    (princ "\n选择要物体依附基准物: ")
    (setq en (ssname (ssget ":S" '((0 . "*POLYLINE,ARC,LINE,CIRCLE,ELLIPSE,SPLINE")))0))
    (setq PP (vlax-curve-getclosestpointto en pt T))
    (initget "1 0")
    (setq XZ (getkword "\n是否旋转物体[旋转(1)/不旋转(0)]<1>："))
    (if (= xz nil) (setq xz 1))
    (cond
    ((eq xz "1") "1")
    ((eq xz "0") "0")
        
  )
    (setq dd (distance pt pp))
    (if (< dd 1e-6)     (setq dd 0))
    (if (= dd 0)
        (progn
            (setq
                ds (angle pt
                         (vlax-curve-getFirstDeriv
                             en
                             (vlax-curve-getparamatpoint
                                 en
                                 (vlax-curve-getclosestpointto en pt)
                             )
                         )
                     )
            )
            (setq    ds (- ds (/ pi 2)))
        )
        (setq ds (angle pt pp) )
    )
    (setvar "cmdecho" 0)  
    (command "_.UNDO" "BE")
   
    (setq oldos(getvar "osmode"))
    (setvar "osmode" 0)
    (while (and (setq re (grread 5))(= (car re) 5))
        (redraw)
        (setq CZ (vlax-curve-getclosestpointto en (cadr re) T))
        (setq dsn (angle cz (cadr re) ))
        (setq CZ (polar cz dsn dd))
        (setq du1 (angtos (- dsn ds) 0 4))
        (grdraw CZ    (cadr re)    2)
        (vl-cmdf "move" ss  "" pt CZ)
        (if (eq xz "1")
            (vl-cmdf "rotate" ss "" cz du1 )
        )
        
        (setq ds dsn )
        (setq pt CZ)
    ) ;while
  (redraw)
    (setvar "osmode" oldos)
    (command "_.UNDO" "E")
    (setvar "cmdecho" 1)  
  (princ)
) ;defun

MENGZE

沙发顶楼主一个

革天明

代码不错，谢谢楼主分享

依然小小鸟

不错的帖子