[原创]动态拉伸接受输入和捕捉

raoc5

请选择要拉伸多段线:; 错误: no function definition: VLAX-CURVE-GETCLOSESTPOINTTO

yxl88168

谢谢楼主，只是拉的距离好像不对

xyz2009xyz

呵呵，怎么在cad2004下面变成移动命令啦？单线好像也没效果！

海盗曹

支持一下，画图时候一下下的s很费劲那

smartstar

学习学习。

springwillow

支持一下楼主!应该花了不少心思。

smartstar

向楼主学习。

香田里浪人

如下程序可用于闭合多段线
;;;多义线拉伸

(defun c:ddxls (/ E G O P1 P2 V1 V2 V3)
              ;|
*************************************************************************************************
*
*        ljs 2013.05.18

*************************************************************************************************
|;
(setq e  (entsel)
       p1 (cadr e)
       e  (car e)
       p1 (fix (vlax-curve-getParamAtPoint e (vlax-curve-getClosestPointTo e p1)))
       o  (vlax-ename->vla-object e)
) ;_  setq
(if (= 1 (cdr (assoc 70 (entget e))))
  (cond ((zerop p1)
         (setq p2 (1+ p1)
               v1 (list (vlax-curve-getPointAtParam e (vlax-curve-getEndParam e))
                        (vlax-curve-getFirstDeriv e (1- (vlax-curve-getEndParam e)))
                  ) ;_  list
               v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e 0.5))
               v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e 1.5))
         ) ;_  setq
        )
        ((= p1 (1- (vlax-curve-getEndParam e)))
         (setq p2 0
               v1 (list (vlax-curve-getPointAtParam e (1- p1))
                        (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
                  ) ;_  list
               v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e (+ p1 0.5)))
               v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e (+ p2 0.5)))
         ) ;_  setq
        )
        ((setq p2 (1+ p1)
               v1 (list (vlax-curve-getPointAtParam e (1- p1))
                        (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
                  ) ;_  list
               v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e (+ p1 0.5)))
               v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e (+ p2 0.5)))
         ) ;_  setq
        )
  ) ;_  cond
  (cond ((zerop p1)
         (setq p2 (1+ p1)
               v2 (list (vlax-curve-getPointAtParam e 0) (vlax-curve-getFirstDeriv e 0.5))
               v1 (list (car v2) (list (cadadr v2) (- (caadr v2)) 0.))
               v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e 1.5))
         ) ;_  setq
        )
        ((= p1 (1- (vlax-curve-getEndParam e)))
         (setq p2 (vlax-curve-getEndParam e)
               v1 (list (vlax-curve-getPointAtParam e (1- p1))
                        (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
                  ) ;_  list
               v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e (+ p1 0.5)))
               v3 (list (vlax-curve-getPointAtParam e p2) (list (cadadr v2) (- (caadr v2)) 0.))
         ) ;_  setq
        )
        ((setq p2 (1+ p1)
               v1 (list (vlax-curve-getPointAtParam e (1- p1))
                        (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
                  ) ;_  list
               v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e (+ p2 0.5)))
               v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e (+ p1 0.5)))
         ) ;_  setq
        )
  ) ;_  cond
) ;_  if
(while (= (car (setq g (grread nil 5 0))) 5)
  (vla-put-coordinate
   o
   p1
   (vlax-make-variant
    (vlax-safearray-fill (vlax-make-safearray 5 '(0 . 1))
                         (reverse (cdr (reverse (inters (car v1)
                                                        (mapcar '+ (car v1) (cadr v1))
                                                        (cadr g)
                                                        (mapcar '+ (cadr g) (cadr v2))
                                                        nil
                                                ) ;_  inters
                                       ) ;_  reverse
                                  ) ;_  cdr
                         ) ;_  reverse
    ) ;_  vlax-safearray-fill
   ) ;_  vlax-make-variant
  ) ;_  vla-put-coordinate
  (vla-put-coordinate
   o
   p2
   (vlax-make-variant
    (vlax-safearray-fill (vlax-make-safearray 5 '(0 . 1))
                         (reverse (cdr (reverse (inters (car v3)
                                                        (mapcar '+ (car v3) (cadr v3))
                                                        (cadr g)
                                                        (mapcar '+ (cadr g) (cadr v2))
                                                        nil
                                                ) ;_  inters
                                       ) ;_  reverse
                                  ) ;_  cdr
                         ) ;_  reverse
    ) ;_  vlax-safearray-fill
   ) ;_  vlax-make-variant
  ) ;_  vla-put-coordinate
) ;_  while
(princ)
)

  (command "undo" "e")
(setvar "osmode" oldos)        ;还原捕捉

jyzas

不错，学习学习

侑嚸俊

谢谢分享，，，谢谢分享，，，谢谢分享，，，