求一个改进的移动拉伸命令

wxa123wl

工作中很多时候需要把很多图对齐与一条线，大概如图的工作过程，所以希望大神些一个，，先选择一条线，然后框选对象，再指定对象上的一点，就可以以这点垂直移动到线上！，还有拉伸，，

lyqiezi

刚发现需要连续执行，改进如下

(vl-load-com)
(defun c:t1( / e1 ss pt1 obj pt2)
    (setq e1 (cdr (assoc -1 (entget (car (entsel "\n select line:"))))))
    (while(setq ss (ssget))
    (setq pt1 (getpoint "\对齐点:"))
    (setq obj (vlax-ename->vla-object e1))
    (setq pt2 (vlax-curve-getClosestPointTo obj pt1 T));求垂足
    (command "move" ss "" pt1 pt2)
    )
   
)

对应一条直线，只需要点一次，后面只要选对齐的物体就可以了

lyqiezi

(vl-load-com)
(defun c:t1( / e1 ss pt1 obj pt2)
    (setq e1 (cdr (assoc -1 (entget (car (entsel "\n select line:"))))))
    (setq ss (ssget))
    (setq pt1 (getpoint "\对齐点:"))
    (setq obj (vlax-ename->vla-object e1))
    (setq pt2 (vlax-curve-getClosestPointTo obj pt1 T));求垂足
    (command "move" ss "" pt1 pt2)
   
)

试一下，拉伸的我没弄出来，不知道什么地方有问题

lyqiezi

(defun c:t2( / e1 ss pt1 obj pt2)
    (setq e1 (cdr (assoc -1 (entget (car (entsel "\n select line:"))))))
    (while(setq ss (ssget))
    (setq pt1 (getpoint "\对齐点:"))
    (setq obj (vlax-ename->vla-object e1))
    (setq pt2 (vlax-curve-getClosestPointTo obj pt1 T));求垂足
    (command "stretch" ss "" pt1 pt2)

    )
   
)
拉伸的，不知道怎么回事，从别的程序复制粘贴命令过来就可以，没觉得跟开始的有什么不同

断箭

lyqiezi 发表于 2014-8-7 22:27
刚发现需要连续执行，改进如下

(vl-load-com)

这个小程序对我很有用，谢谢啦

1152213153

跪看大神们交流

sdls

感谢楼上的大神们分享！谢谢