动态拉伸多段线的边

marting · 发表于 2021-1-17 10:50:47

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:ofss (/ E G O P1 P2 V1 V2 V3)
;|
*************************************************************************************************
*
* by ElpanovEvgeniy 26.02.2010
*
* ----------------
* 27.02.2010 8:30
* fix bug for acad 2004 (vlax-curve-getFirstDeriv e (vlax-curve-getEndParam e))
* ----------------
* 27.02.2010 8:55
* fix bug for first arc segment
*************************************************************************************************
|;
(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)
)

(defun c:ofss (/ E G O P1 P2 V1 V2 V3) 
              ;| 
************************************************************************************************* 
* 
*        by ElpanovEvgeniy 26.02.2010 
* 
*        ---------------- 
*        27.02.2010 8:30 
*        fix bug for acad 2004 (vlax-curve-getFirstDeriv e (vlax-curve-getEndParam e)) 
*        ---------------- 
*        27.02.2010 8:55 
*        fix bug for first arc segment 
************************************************************************************************* 
 
 |; 
 (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) 
)

另外一个实现：

&#21160;&#24577;&#22810;&#36793;&#24418;&#26576;&#36793;&#31227;.gif

游客，本帖隐藏的内容需要积分高于 30 才可浏览，您当前积分为 0

ynhh · 发表于 2021-1-17 20:05:24

好牛啊，大师多介绍些好玩的程序

暮雨晨曦 · 发表于 2021-1-17 22:45:23

能解决捕捉的问题吗

SHUNDocker · 发表于 2021-1-18 00:08:20

厉害楼主，感谢分享！！！

xdzcp · 发表于 2021-1-25 22:04:59

这个功能好谢谢分享

创佳 · 发表于 2021-4-5 13:16:38

无法精确输入拉伸距离！！！

sujia · 发表于 2021-9-3 23:42:54

牛逼啊厉害

暮雨晨曦 · 发表于 2021-10-14 22:16:37

能解决捕捉的问题吗

hh_lj007 · 发表于 2021-10-15 08:33:54

感谢大神分享源码

sunyukun · 发表于 2022-6-1 17:36:31

可以加个qq吗

sunyukun · 发表于 2022-6-1 17:37:54

359761054 可以加个qq吗

账号		自动登录	找回密码
密码			立即注册

[每日一码] 动态拉伸多段线的边

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。