自贡黄明儒 发表于 2024-2-29 08:37:26

沿曲线上两点移动对象

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

   (setq ang1 (vlax-curve-getParamAtPoint e0 p1))
   (setq ang1 (vlax-curve-getFirstDeriv e0 ang1))
   (setq ang1 (angle ang1 '(0 0 0)))
   (setq ang2 (vlax-curve-getParamAtPoint e0 p2))
   (setq ang2 (vlax-curve-getFirstDeriv e0 ang2))
   (setq ang2 (angle ang2 '(0 0 0)))
   (setq ang (/ (* (- ang2 ang1) 180) pi))   
      (ACET-UNDO-BEGIN)
      (vl-cmdf "_.move" ss "" "non" p1 "non" p2)
      (vl-cmdf "._rotate" ss "" "non" p2 ang)
      (ACET-UNDO-END)
    )
)
(princ "\n沿曲线上两点移动对象 Mee")
(princ)
)
(princ "\n 沿曲线上两点移动对象 Mee")
(princ)
;;;[功能]沿曲线移动 Move by curve=============================================

panliang9 发表于 2024-2-29 08:51:52

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

love1030312 发表于 2024-2-29 19:04:13

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

dd131028 发表于 2024-3-2 10:05:44

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

xyp1964 发表于 2024-3-3 13:37:15

沿曲线移动实体

页: [1]
查看完整版本: 沿曲线上两点移动对象