动态拖动增加多段线顶点工具

至尊宝宝 · 发表于 2021-4-29 10:58:09

感谢楼主分享！！！！

Cafemeow · 发表于 2021-4-30 00:32:35

学习是怎么办到的

lock0000 · 发表于 2021-5-1 23:06:52

很实用的工具！谢谢分享！

qq303026080 · 发表于 2021-5-7 23:51:19

这个不错，实用

音河之声 · 发表于 2021-5-11 11:57:06

sujia · 发表于 2021-9-4 00:07:07

(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)
)

CAD56390 · 发表于 2021-11-2 13:43:32

用处不是很多啊

lsfanlijie · 发表于 2021-11-21 10:52:01

真的是太牛逼了
...

老仓测绘上班记 · 发表于 2022-5-3 23:06:13

谢谢版主，学习了

yaojing38 · 发表于 2022-5-5 15:14:37

谢谢分享，，很实用

dyjwyqz5221 · 发表于 2022-6-5 09:22:30

查看下，是怎么回事

searienon · 发表于 2022-6-13 11:56:50

好东西，多谢楼主

boylovecfy · 发表于 2022-6-20 19:16:08

这个功能不错哈呵呵

小溪潺潺 · 发表于 2022-8-8 05:13:44

谢谢分享学习一下

qq787116960 · 发表于 2022-9-22 18:12:05

动态拖动增加多段线顶点工具

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

[多段线] 动态拖动增加多段线顶点工具