小笨智能中心线v1.4(2019-12-29更新)

jh1005

aaacjh 发表于 2012-9-6 21:57
我也用布局出图,图面整洁!不知楼主的认识~!!同一张图,d50和d5的孔是会有同时出现的时候的,适应性是一个好 ...

已增加自动线型比例，谢谢你的意见。

汪若飞wangrf

hutengfei 发表于 2012-9-6 19:40
请问平行线中心线延长为总长的0.1倍，怎么修改啊？
不甚感谢！

(defun 2Line-center          ;两线中心线
(en1 en2 / p1 p2 p3 p4 p5 p6 ang1 ang2 p1_2 p3_4)
   (setq p1 (vlax-curve-getstartpoint en1)
         p2 (vlax-curve-getendpoint en1)
         p3 (vlax-curve-getstartpoint en2)
         p4 (vlax-curve-getendpoint en2)
                p5 (inters p1 p2 p3 p4 nil)
        )
   (cond
     (p5  ;不平行
           (setq ang1 (angle p5 (fy-m2p p1 p2)))
           (setq ang2 (angle p5 (fy-m2p p3 p4)))
           (setq p6 (polar p5 (- (max ang1 ang2) (/ (abs (- ang1 ang2)) 2)) (distance p1 p2)))
       (setq p1_2 (vl-sort (list p1 p2) (function (lambda (a b) (< (distance a p5) (distance b p5))))))
       (setq p3_4 (vl-sort (list p3 p4) (function (lambda (a b) (< (distance a p5) (distance b p5))))))
       (setq p1 (car p1_2) p2 (cadr p1_2))
       (setq p3 (car p3_4) p4 (cadr p3_4))
           (if (> (distance p1 p3) 0) ;避免p1,p3共点情况取不到交点
             (setq p5 (inters p5 p6 p1 p3 nil))
           )
           (if (and
                 (inters p1 p2 p3 p4)
                 (and (> (distance p1 p5) 0.00000001)
                             (> (distance p2 p5) 0.00000001)
                             (> (distance p3 p5) 0.00000001)
                             (> (distance p4 p5) 0.00000001)
                         )
               )
            (progn  ;交叉线
                  (setq p6 (inters p5 p6 p2 p4 nil))
                  (Line-Scale (makeline p5 p6) lay)
                  (setq p5 (inters p1 p2 p3 p4))
                  (setq p6 (polar p5 (+ (angle p5 p6) (/ pi 2)) (distance p5 p6)))
           (setq p6 (inters p5 p6 p1 p4 nil))
           (setq p5 (inters p5 p6 p2 p3 nil))
                  (Line-Scale (makeline p5 p6) lay)
                )
            (progn  ;非交叉线
                  (setq p6 (inters p5 p6 p2 p4 nil))
                  (Line-Scale (makeline p5 p6) lay)
                )
           )
         )
         (t  ;平行线
            (setq p5 (fy-m2p p1 (PerToLine p1 p3 p4)))
            (setq p6 (fy-m2p p2 (PerToLine p2 p3 p4)))
                (if (inters p1 p3 p2 p4)
                  (progn
                     (setq p5 (inters p5 p6 p1 p4 nil))
                 (setq p6 (inters p5 p6 p2 p3 nil))
                        (Line-Scale (makeline p5 p6) lay)
                  )
                  (progn
                     (setq p5 (inters p5 p6 p1 p3 nil))
                 (setq p6 (inters p5 p6 p2 p4 nil))
                        (Line-Scale (makeline p5 p6) lay)
                  )
                )
         )
   )
(princ)


这个是2012-9-6版本的
楼主您好，可以指点下，怎么修改么！

13579

很实用。谢谢分享源码。

jh1005

汪若飞wangrf 发表于 2012-9-8 22:40
(defun 2Line-center          ;两线中心线
(en1 en2 / p1 p2 p3 p4 p5 p6 ang1 ang2 p1_2 p3_4)
    ...

把(Line-Scale (makeline p5 p6) lay)几句改为：

(Line-Scale (makeline
  (polar p6 (angle p6 p5) (+ (distance p5 p6) (* (distance p5 p6) 0.1))) ;0.1倍
  (polar p5 (angle p5 p6) (+ (distance p5 p6) (* (distance p5 p6) 0.1))) ;0.1倍
) lay )

汪若飞wangrf

jh1005 发表于 2012-9-10 22:27
把(Line-Scale (makeline p5 p6) lay)几句改为：

(Line-Scale (makeline

太感谢楼主了，用过最完美的智能中心线程序！

aaa862

太强大了

jh1005

yjr111 发表于 2012-9-4 20:40
支持一下，不过好像还有点问题。

你的图中有一个矩形不是多义线，现在的1.2版已支持。
程序毕竟不是万能的，很难识别各种各样的图形，要适当选择图形。

zhaozwf

关注中。。。。。。。。。。。。。。

Jalinnet

有一个bug：选择一个圆或矩形生成中心线，然后选择这两条中心线，却生成一条水平或垂直的重合线

flytoday

运行太慢了~~~~~~~~~~~~~~~

多了直接卡死