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

daidong013 · 发表于 2012-9-14 12:47:00

本帖最后由 daidong013 于 2012-9-15 10:17 编辑

求助高手们！~有这样的工具吗？！~~

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

各种方向都行

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

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

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

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

664571221 · 发表于 2018-7-8 15:55:05

Gu_xl 发表于 2012-9-14 15:33
[/post]

G版能不能完善下竖向

daidong013 · 发表于 2012-9-14 13:27:53

一条两条线用直线连起来是比较方便，但线多了就比较麻烦一点了！~呵呵！~

Gu_xl · 发表于 2012-9-14 15:33:16

本帖最后由 Gu_xl 于 2012-9-14 16:10 编辑

游客，本帖隐藏的内容需要发帖数高于 10 才可浏览，你当前发帖数只有 0

叮咚 · 发表于 2012-9-14 15:41:03

还是版主牛啊

daidong013 · 发表于 2012-9-14 16:31:47

Gu_xl 发表于 2012-9-14 15:33
[/post]

G版出手果然非同凡响，赞赞赞

！~
就是这样的效果,感谢感谢

！~~

daidong013 · 发表于 2012-9-14 17:43:56

本帖最后由 daidong013 于 2012-9-14 17:52 编辑

Gu_xl 发表于 2012-9-14 15:33
[/post]

G版，如果图形变为竖向的时候好像有点问题！~~

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

lz123456 · 发表于 2012-9-14 23:57:42

G大的程序个个是经典，竖向的不晓得怎么改。改哪里？

lz123456 · 发表于 2012-9-15 01:07:53

还有个问题就是在UCS下不能用

shyshineboy · 发表于 2012-10-31 08:24:23

直接用连接也不慢呢

zzc83 · 发表于 2012-11-3 23:57:46

留个记号，以后用得上

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

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

本帖子中包含更多资源

点评

相关帖子

评分

本帖子中包含更多资源

点评