请选择 进入手机版 | 继续访问电脑版
天气与日历 切换到窄版

 找回密码
 立即注册
中国膜结构网
十大进口膜材评选 十大国产膜材评选 十大膜结构设计评选 十大膜结构公司评选
查看: 19|回复: 0

[功能]沿曲线移动

[复制链接]
  • TA的每日心情
    开心
    3 天前
  • 签到天数: 54 天

    [LV.5]常住居民I

    1263

    主题

    149

    回帖

    214748万

    积分

    管理员

    积分
    2147483647
    发表于 2024-2-29 11:05:09 | 显示全部楼层 |阅读模式
    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.      (setq ang1 (vlax-curve-getParamAtPoint e0 p1))
    32.      (setq ang1 (vlax-curve-getFirstDeriv e0 ang1))
    33.      (setq ang1 (angle ang1 '(0 0 0)))
    34.      (setq ang2 (vlax-curve-getParamAtPoint e0 p2))
    35.      (setq ang2 (vlax-curve-getFirstDeriv e0 ang2))
    36.      (setq ang2 (angle ang2 '(0 0 0)))
    37.      (setq ang (/ (* (- ang2 ang1) 180) pi))     
    38.       (ACET-UNDO-BEGIN)
    39.       (vl-cmdf "_.move" ss "" "non" p1 "non" p2)
    40.       (vl-cmdf "._rotate" ss "" "non" p2 ang)
    41.       (ACET-UNDO-END)
    42.     )
    43.   )
    44.   (princ "\n沿曲线上两点移动对象 Mee")
    45.   (princ)
    46. )
    47. (princ "\n 沿曲线上两点移动对象 Mee")
    48. (princ)
    49. ;;;[功能]沿曲线移动 Move by curve=============================================
    50. "觉得好,就打赏"
    复制代码

     

     

     

     

    [功能]沿曲线移动
    中国膜结构网打造全中国最好的膜结构综合平台 ,统一协调膜结构设计,膜结构施工,膜材采购,膜材定制,膜结构预算全方位服务。 中国空间膜结构协会合作单位。
    您需要登录后才可以回帖 登录 | 立即注册

    本版积分规则

    QQ|Archiver|手机版|中国膜结构网_中国空间膜结构协会

    GMT+8, 2024-3-29 21:29 , Processed in 0.064031 second(s), 21 queries .

    Powered by Discuz! X3.5

    © 2001-2024 Discuz! Team.

    快速回复 返回顶部 返回列表