Gray-wolf 发表于 2018-6-4 00:23:51

;物体沿曲线移动

;物体沿曲线移动
(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 发表于 2018-6-4 03:55:47

沙发顶楼主一个

革天明 发表于 2018-6-4 09:26:10

代码不错，谢谢楼主分享

依然小小鸟 发表于 2018-12-15 21:43:32

不错的帖子
页: [1]
查看完整版本: ;物体沿曲线移动