社区 › AutoLISP/Visual LISP 编程技术 › [原创]动态拉伸接受输入和捕捉

raoc5 发表于 2011-4-12 12:54:18

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

yxl88168 发表于 2011-4-16 11:33:31

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

xyz2009xyz 发表于 2011-4-21 18:14:45

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

海盗曹 发表于 2012-5-15 17:02:22

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

smartstar 发表于 2012-6-16 16:34:39

学习学习。

springwillow 发表于 2012-6-26 15:03:00

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

smartstar 发表于 2012-6-26 15:37:46

向楼主学习。

香田里浪人 发表于 2013-5-27 22:38:15

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

(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 发表于 2013-7-11 18:40:32

不错，学习学习

侑嚸俊 发表于 2019-1-2 23:11:21

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

查看完整版本: [原创]动态拉伸接受输入和捕捉