【求助】有这样框选连线的工具吗？~~[G版已解决]期待竖向完善！

wolaixuexi · 发表于 2019-9-18 09:13:51

留个记号，谢谢

yaokui25 · 发表于 2020-6-14 09:15:51

daidong013 发表于 2012-9-14 17:43
G版，如果图形变为竖向的时候好像有点问题！~~

或者判断以距离长的优先，不知可行否！！！

楼主，不知竖向的是否解决了？

趣意人生 · 发表于 2021-1-29 21:12:50

G版出手果然非同凡响

sn2200 · 发表于 2021-2-8 16:12:42

留个记号

冯罗国 · 发表于 2021-6-25 01:50:24

还是版主牛啊

kkq0305 · 发表于 2021-6-25 03:43:27

(defun c:DJLX (/ instpd p1 p2 minpt maxpt ss en pl pt)
(defun instpd (lst / a b c d)
(mapcar 'set '(a b c d) lst)
(if (not (apply 'inters (mapcar 'car (list a b c d))))
(if (equal (angle (car b) (car a)) (cadr a) (* 0.25 pi))
(list (list (car a) (car b)) (list (car c) (car d)))
(instpd (list a c b d))
)
(instpd (list a c d b))
)
)
(while (and
(setq p1 (getpoint "\n第一点: "))
(setq p2 (getcorner p1 "\n对角点: "))
)
(mapcar 'set
'(minpt maxpt)
(list (mapcar 'min p1 p2) (mapcar 'max p1 p2))
)
(setq ss (ssget "c" p1 p2 '((0 . "line,*polyline"))))
(if ss
(progn
(setq pl nil)
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(if (apply 'and
(mapcar '<=
minpt
(setq pt (vlax-curve-getStartPoint
(vlax-ename->vla-object en)
)
)
maxpt
)
)
(setq pl
(cons
(list pt
(angle pt
(mapcar '+
pt
(vlax-curve-getFirstDeriv
(vlax-ename->vla-object en)
(vlax-curve-getStartParam
(vlax-ename->vla-object en)
)
)
)
)
)
pl
)
)
(setq pl
(cons
(list (setq pt (vlax-curve-getEndPoint
(vlax-ename->vla-object en)
)
)
(angle pt
(mapcar '+
pt
(vlax-curve-getFirstDeriv
(vlax-ename->vla-object en)
(vlax-curve-getEndParam
(vlax-ename->vla-object en)
)
)
)
)
)
pl
)
)
)
)
(foreach n (instpd pl)
(entmake (list '(0 . "line")
'(62 . 1)
(cons 10 (car n))
(cons 11 (cadr n))
)
)
)
)
)
)
(princ)
)

(defun c:DJLX (/ instpd p1 p2 minpt maxpt ss en pl pt) 
  (defun instpd        (lst / a b c d) 
    (mapcar 'set '(a b c d) lst) 
    (if        (not (apply 'inters (mapcar 'car (list a b c d)))) 
      (if (equal (angle (car b) (car a)) (cadr a) (* 0.25 pi)) 
        (list (list (car a) (car b)) (list (car c) (car d))) 
        (instpd (list a c b d)) 
      ) 
      (instpd (list a c d b)) 
    ) 
  ) 
  (while (and 
           (setq p1 (getpoint "\n第一点: ")) 
           (setq p2 (getcorner p1 "\n对角点: ")) 
         ) 
    (mapcar 'set 
            '(minpt maxpt) 
            (list (mapcar 'min p1 p2) (mapcar 'max p1 p2)) 
    ) 
    (setq ss (ssget "c" p1 p2 '((0 . "line,*polyline")))) 
    (if        ss 
      (progn 
        (setq pl nil) 
        (repeat        (setq n (sslength ss)) 
          (setq en (ssname ss (setq n (1- n)))) 
          (if (apply 'and 
                     (mapcar '<= 
                             minpt 
                             (setq pt (vlax-curve-getStartPoint 
                                        (vlax-ename->vla-object en) 
                                      ) 
                             ) 
                             maxpt 
                     ) 
              ) 
            (setq pl 
                   (cons 
                     (list pt 
                           (angle pt 
                                  (mapcar '+ 
                                          pt 
                                          (vlax-curve-getFirstDeriv 
                                            (vlax-ename->vla-object en) 
                                            (vlax-curve-getStartParam 
                                              (vlax-ename->vla-object en) 
                                            ) 
                                          ) 
                                  ) 
                           ) 
                     ) 
                     pl 
                   ) 
            ) 
            (setq pl 
                   (cons 
                     (list (setq pt (vlax-curve-getEndPoint 
                                      (vlax-ename->vla-object en) 
                                    ) 
                           ) 
                           (angle pt 
                                  (mapcar '+ 
                                          pt 
                                          (vlax-curve-getFirstDeriv 
                                            (vlax-ename->vla-object en) 
                                            (vlax-curve-getEndParam 
                                              (vlax-ename->vla-object en) 
                                            ) 
                                          ) 
                                  ) 
                           ) 
                     ) 
                     pl 
                   ) 
            ) 
          ) 
        ) 
        (foreach n (instpd pl) 
          (entmake (list '(0 . "line") 
                         '(62 . 1) 
                         (cons 10 (car n)) 
                         (cons 11 (cadr n)) 
                   ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

各种方向都行

dongya1235 · 发表于 2021-6-25 22:11:06

对个暗号:P

冯罗国 · 发表于 2021-6-29 02:21:24

留个记号，以后用得上

weizhenyu2000 · 发表于 2021-6-29 19:57:56

学习学习多谢

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

【求助】有这样框选连线的工具吗？~~[G版已解决]期待竖向完善！

浏览过的版块