两多段线在X轴方向的最短距离

/db_自贡黄明儒_ · 发表于 2014-4-3 19:52:13

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

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

×

这几天出差，大部分时间都在车上，无聊时思考一个问题：求两条多段线的最小距离，觉得好解决，打算今后有空写写这个。
对于两条多段线在X轴向能移多少就相碰，觉得这个实用价值更大，各位高人有没有好办法？

st788796 · 发表于 2014-4-3 22:02:53

本帖最后由 st788796 于 2014-4-3 22:04 编辑

排版？

newer · 发表于 2014-4-3 22:10:08

都是直线段的多段线吗？

ysq101 · 发表于 2014-4-3 23:35:49

实话说。。。不太明白黄大师的意思

/db_自贡黄明儒_ · 发表于 2014-4-4 09:08:36

newer 发表于 2014-4-3 22:10
都是直线段的多段线吗？

考虑凹凸情况{:soso_e113:}

st788796 · 发表于 2014-4-4 10:26:14

每一段最左（右）侧点向对面线做射线，第一个交点和该点距离最小的

/db_自贡黄明儒_ · 发表于 2014-4-4 12:32:53

本帖最后由 /db_自贡黄明儒_ 于 2014-4-4 13:16 编辑

st788796 发表于 2014-4-4 10:26
每一段最左（右）侧点向对面线做射线，第一个交点和该点距离最小的

这方法不行，弧同弧可能相交了。

st788796 · 发表于 2014-4-4 13:04:16

本帖最后由 st788796 于 2014-4-4 13:05 编辑

/db_自贡黄明儒_ 发表于 2014-4-4 12:32
这方法不行，弧同弧可能相交了。

弧段要找弧上点（外凸），由圆心引水平线，直线段是端点

aeo · 发表于 2014-4-4 14:25:38

以前有人写过，好多年前了。
我记得好像是写飞诗的那个，但不确定，自己找吧

牢固 · 发表于 2014-4-4 16:43:07

/db_自贡黄明儒_ 发表于 2014-4-4 12:32
这方法不行，弧同弧可能相交了。

算法可采用二分法，水平方向移动多一个边形，计算两多边形的交点，当收敛到一定的精度后，这个多边形移动的距离就是两多边形的水平间距了！

434939575 · 发表于 2014-4-6 14:29:29

期待大师出手。新的一年。能学到新知识。感想。

/db_自贡黄明儒_ · 发表于 2014-4-7 13:50:45

本帖最后由 /db_自贡黄明儒_ 于 2014-9-28 10:35 编辑

牢固发表于 2014-4-4 16:43
算法可采用二分法，水平方向移动多一个边形，计算两多边形的交点，当收敛到一定的精度后，这个多边形移动 ...

研究了几天，不用逼近法，可以一步到位求解

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;过一点求曲线上X(Y)轴上交点
;;[功能] X轴(Y轴)构造线
;;Flag T时,在X轴线上产生射线
;;示例 (EntmakeXline (getpoint) "X")产生平行X轴的射线
(defun EntmakeXline (pt Flag / P1)
(if Flag
(setq p1 '(1 0 0))
(setq p1 '(0 1 0))
)
(entmakeX (list '(0 . "XLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbXline")
(cons 10 pt)
(cons 11 p1)
)
)
)
;;[功能] 两对象交点列表
;;acextendnone 0 不延伸
;;acextendthisentity 1 延伸基准对象
;;acextendotherentity 2
;;acextendboth 3
;;示例(HH:TwoEntsInters (car(entsel)) (car(entsel)) 0)
(defun HH:TwoEntsInters (e1 e2 Flag / OBJ1 OBJ2 PTL PTS)
(setq obj1 (vlax-ename->vla-object e1))
(setq obj2 (vlax-ename->vla-object e2))
(setq pts (vlax-invoke obj1 'Intersectwith obj2 Flag))
(while pts
(setq ptl (cons (list (car pts) (cadr pts)) ptl))
(setq pts (cdddr pts))
)
ptl
)
;;[功能] 过一点射线与曲线的交点
;;示例(HH:XYCurvePt (car(entsel)) (getpoint) "X"),返回过一点X轴上的点
(defun HH:XYCurvePt (e1 pt Flag / E2 LST PTS)
(setq e2 (EntmakeXline pt Flag))
(setq pts (HH:TwoEntsInters e1 e2 0))
(entdel e2)
(foreach x pts
(setq lst (cons (list (distance x pt) x pt) lst))
)
lst
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;过一点求曲线上X(Y)轴上交点
;;[功能] 弧圆心或者半径
;;示例(HH:getArcCen (car(entsel)))
(defun HH:getArcCen (e / CEN OBJ R)
(setq obj (vlax-ename->vla-object e))
(setq R (vlax-get obj 'Radius))
(setq Cen (vlax-get obj 'Center))
(list R Cen)
)
;;[功能] 画直线
(defun EntmakeLine (p1 p2)
(entmakeX (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
)
;;1 [功能] 弧与直线在X轴(Y轴)方向的最短距离
;;Flag T时，X轴方向最短距离
;;(HH:LineArcShort (car(entsel))(car(entsel)) T)=>(6.9505 (-1400.95 2003.86) (-1394.0 2003.86))
;;=>(距离弧上点直线上点) 或 nil(nil说明这种方法求得的不是最短距离)
(defun HH:LineArcShort (eA eL Flag / CEN E P1 P2 PT PTS SCOR)
(setq Cen (cadr (HH:getArcCen eA)))
(setq pt (vlax-curve-getClosestPointTo EL Cen T))
(setq e (EntmakeLine Cen pt)) ;圆心到直线的垂线
(setq pts (HH:TwoEntsInters eA e 0))
(entdel e)
(cond
(pts
(setq p1 (car pts)) ;弧与垂线交点
(setq e (EntmakeXline p1 Flag)) ;作一射线
(setq pts (HH:TwoEntsInters EL e 0)) ;射线与原直线交点
(entdel e)
(cond
(pts
(setq p2 (car pts))
(setq Scor (list (distance p1 p2) p1 p2))
)
)
)
)
Scor
)
;;2 [功能] 弧与弧在X轴(Y轴)方向的最短距离
;;Flag T时，X轴方向最短距离
;;(移动距离第二对象移动基点移动到)或者nil(nil表示此最小移动距离为端点)
;;(HH:TwoArcShort (car(entsel)) (car(entsel)) T)=>(12.3644 (-1334.55 2032.55 0.0) (-1346.91 2032.55))
(defun HH:TwoArcShort (eA1 eA2 Flag / CEN1 CEN2 ECIRCLE ELINE OBJ P2 PTS R1 R2 SCOR)
(setq Cen1 (HH:getArcCen eA1))
(setq R1 (car Cen1))
(setq Cen1 (cadr Cen1))
(setq Cen2 (HH:getArcCen eA2))
(setq R2 (car Cen2))
(setq Cen2 (cadr Cen2))
(setq eCircle (EntmakeCircle Cen2 (+ R1 R2))) ;以第圆中心画一圆
(if Flag
(setq p2 (list (car Cen2) (cadr Cen1)))
(setq p2 (list (cadr Cen2) (car Cen1)))
)
(setq eLine (EntmakeLine Cen1 p2)) ;圆1到圆2中心处，产生一直线
(setq pts (car (HH:TwoEntsInters eCircle eLine 0))) ;新产生圆与新产生直线交点
(entdel eCircle)
(entdel eLine)
(if pts
(progn
(setq pts (mapcar '- pts Cen1))
(setq p2 (mapcar '- Cen2 pts)) ;圆2新中心点
(setq eLine (EntmakeLine Cen1 p2))
(setq pts (HH:TwoEntsInters eA1 eLine 0))
(cond
(pts
(setq obj (vla-copy (vlax-ename->vla-object eA2)))
(vla-move obj (vlax-3d-point Cen2) (vlax-3d-point p2))
(setq pts (HH:TwoEntsInters eLine (entlast) 0))
(entdel eLine)
(entdel (entlast))
(cond
(pts
(setq Scor (list (distance p2 Cen2) Cen2 p2))
)
)
)
(T (entdel eLine))
)
)
)
Scor
)
;;[功能] 画圆
(defun EntmakeCircle (p r)
(entmakeX (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r)))
)
;;[功能] 两多段线之间最小距离自贡黄明儒2014.4.6
(defun C:HH:TwoLWPShort (/ CPT1 CPT2 E1 E2 LST P PTS1 PTS2 SS)
(if (and
(setq ss (ssget ":S" '((0 . "LWPOLYLINE"))))
(equal (sslength ss) 2)
)
(progn
(setq e1 (ssname ss 0))
(setq e2 (ssname ss 1))
(setq pts1 (HH:PtLists e1)) ;http://bbs.xdcad.net/thread-671377-1-1.html
(setq pts2 (HH:PtLists e2))
(setq Cpt1 (HH:GetCenter3 e1))
(setq Cpt2 (HH:GetCenter3 e2))
(foreach X pts1
(setq p (vlax-curve-getClosestPointTo e2 x))
(setq lst (cons (list (distance x p) x p) lst))
)
(foreach X pts2
(setq p (vlax-curve-getClosestPointTo e1 x))
(setq lst (cons (list (distance x p) p x) lst))
)
(if Cpt1
(foreach X Cpt1
(setq p (vlax-curve-getClosestPointTo e2 x))
(setq x (vlax-curve-getClosestPointTo e1 p))
(setq lst (cons (list (distance x p) x p) lst))
)
)
(if Cpt2
(foreach X Cpt2
(setq p (vlax-curve-getClosestPointTo e1 x))
(setq x (vlax-curve-getClosestPointTo e2 p))
(setq lst (cons (list (distance x p) p x) lst))
)
)
(setq lst (car (HH:ssPts:Sort lst "x" 0.001)))
(grdraw (cadr lst) (caddr lst) 1)
)
)
lst
)
;;164.48 [功能] 多线上的弧段的圆心列表
;;(HH:GetCenter3 (car(setq en(entsel))))
(defun HH:GetCenter3 (curve / CENLIST EP FLAG MDERIV MP PARAM SP)
;;(setq curve (car (entsel)))
(setq param (fix (vlax-curve-getEndParam curve)))
(setq sp (vlax-curve-getPointAtParam curve param))
(repeat param
(setq param (1- param))
(setq Ep (vlax-curve-getPointAtParam curve param))
(setq Mp (vlax-curve-getPointAtParam curve (+ param 0.5))) ;中点
(setq Mderiv (vlax-curve-getsecondderiv curve (+ param 0.5))) ;中点法线
(setq Flag (car (trans (mapcar '- Mp Ep) 0 (mapcar '- Ep sp))))
(cond ((equal Flag 0) nil)
((minusp Flag)
(setq CenList (cons (mapcar '- Mp Mderiv) CenList))
)
(T
(setq CenList (cons (mapcar '+ Mp Mderiv) CenList))
)
)
(setq sp Ep)
)
CenList
)
;;164.3 [功能] 多段线端点列表
;;示例(HH:PtLists (car (entsel)))
(defun HH:PtLists (en)
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
)
)
;;[功能] 两多段线X轴方向最小距离自贡黄明儒2014.4.6
(defun HH:XLWPShort (ss Flag / CMD1 E1 E11 E2 E21 I J LST S1 S2 SCOR SHORTC TYPE1 TYPE2)
;;错误处理
(defun *error* (msg)
(vl-bt)
(if *DOC*
(_EndUndo *DOC*) ;块内图元增减
)
(while (not (equal (getvar "cmdnames") "")) (command nil))
(if cmd1
(setvar "cmdecho" cmd1)
)
(if SHORTC
(setvar "SHORTCUTMENU" SHORTC)
)
(if s1 (vl-cmdf "_.erase" s1 ""))
(if s2 (vl-cmdf "_.erase" s2 ""))
(setvar "nomutt" 0)
(princ "\n 出错啦!")
(princ)
)
(setq e1 (ssname ss 0))
(setq e2 (ssname ss 1))
(vla-copy (vlax-ename->vla-object e1))
(vl-cmdf "_.explode" (entlast))
(setq s1 (ssget "_p"))
(vla-copy (vlax-ename->vla-object e2))
(vl-cmdf "_.explode" (entlast))
(setq s2 (ssget "_p"))
(repeat (setq i (sslength s1))
(setq e11 (ssname s1 (setq i (1- i))))
(setq type1 (cdr (assoc 0 (entget e11))))
(repeat (setq j (sslength s2))
(setq e21 (ssname s2 (setq j (1- j))))
(setq type2 (cdr (assoc 0 (entget e21))))
(cond
((and (equal type1 "LINE") (equal type2 "ARC"))
(if (setq scor (HH:LineArcShort e21 e11 Flag))
(setq lst (cons scor lst))
)
)
((and (equal type2 "LINE") (equal type1 "ARC"))
(if (setq scor (HH:LineArcShort e11 e21 Flag))
(setq lst (cons scor lst))
)
)
((and (equal type2 "ARC") (equal type1 "ARC"))
(if (setq scor (HH:TwoArcShort e11 e21 Flag))
(setq lst (cons scor lst))
)
)
)
)
)
(vl-cmdf "_.erase" s1 s2 "")
(foreach x (HH:PtLists e1)
(if (setq scor (HH:XYCurvePt e2 x Flag))
(setq lst (append lst scor))
)
)
(foreach x (HH:PtLists e2)
(if (setq scor (HH:XYCurvePt e1 x Flag))
(setq lst (append lst scor))
)
)
(if (setq lst (car (HH:ssPts:Sort lst "x" 0.001)))
(grdraw (cadr lst) (caddr lst) 1)
)
lst
)
(defun C:w1 (/ SS)
(HH:ayOSMode nil) ;关闭捕捉
(if (and
(setq ss (ssget ":S" '((0 . "LWPOLYLINE"))))
(equal (sslength ss) 2)
)
(progn
(HH:XLWPShort ss T);X轴
(HH:XLWPShort ss nil);Y轴
)
)
(HH:ayOSMode T) ;开捕捉
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;过一点求曲线上X(Y)轴上交点 
;;[功能] X轴(Y轴)构造线 
;;Flag T时,在X轴线上产生射线 
;;示例 (EntmakeXline (getpoint) "X")产生平行X轴的射线 
(defun EntmakeXline (pt Flag / P1) 
  (if Flag 
    (setq p1 '(1 0 0)) 
    (setq p1 '(0 1 0)) 
  ) 
  (entmakeX (list '(0 . "XLINE") 
                  '(100 . "AcDbEntity") 
                  '(100 . "AcDbXline") 
                  (cons 10 pt) 
                  (cons 11 p1) 
            ) 
  ) 
) 
;;[功能] 两对象交点列表 
;;acextendnone 0 不延伸 
;;acextendthisentity 1 延伸基准对象 
;;acextendotherentity 2 
;;acextendboth 3 
;;示例(HH:TwoEntsInters (car(entsel)) (car(entsel)) 0) 
(defun HH:TwoEntsInters        (e1 e2 Flag / OBJ1 OBJ2 PTL PTS) 
  (setq obj1 (vlax-ename->vla-object e1)) 
  (setq obj2 (vlax-ename->vla-object e2)) 
  (setq pts (vlax-invoke obj1 'Intersectwith obj2 Flag)) 
  (while pts 
    (setq ptl (cons (list (car pts) (cadr pts)) ptl)) 
    (setq pts (cdddr pts)) 
  ) 
  ptl 
) 
;;[功能] 过一点射线与曲线的交点 
;;示例(HH:XYCurvePt (car(entsel)) (getpoint) "X"),返回过一点X轴上的点 
(defun HH:XYCurvePt (e1 pt Flag / E2 LST PTS) 
  (setq e2 (EntmakeXline pt Flag)) 
  (setq pts (HH:TwoEntsInters e1 e2 0)) 
  (entdel e2) 
  (foreach x pts 
    (setq lst (cons (list (distance x pt) x pt) lst)) 
  ) 
  lst 
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;过一点求曲线上X(Y)轴上交点 
 
;;[功能] 弧圆心或者半径 
;;示例(HH:getArcCen (car(entsel))) 
(defun HH:getArcCen (e / CEN OBJ R) 
  (setq obj (vlax-ename->vla-object e)) 
  (setq R (vlax-get obj 'Radius)) 
  (setq Cen (vlax-get obj 'Center)) 
  (list R Cen) 
) 
 
;;[功能] 画直线 
(defun EntmakeLine (p1 p2) 
  (entmakeX (list '(0 . "LINE") (cons 10 p1) (cons 11 p2))) 
) 
 
;;1 [功能] 弧与直线在X轴(Y轴)方向的最短距离 
;;Flag T时，X轴方向最短距离 
;;(HH:LineArcShort (car(entsel))(car(entsel)) T)=>(6.9505 (-1400.95 2003.86) (-1394.0 2003.86)) 
;;=>(距离 弧上点 直线上点) 或 nil(nil说明这种方法求得的不是最短距离) 
(defun HH:LineArcShort (eA eL Flag / CEN E P1 P2 PT PTS SCOR) 
  (setq Cen (cadr (HH:getArcCen eA))) 
  (setq pt (vlax-curve-getClosestPointTo EL Cen T)) 
  (setq e (EntmakeLine Cen pt))                                    ;圆心到直线的垂线 
  (setq pts (HH:TwoEntsInters eA e 0)) 
  (entdel e) 
  (cond 
    (pts 
     (setq p1 (car pts))                                    ;弧与垂线交点 
     (setq e (EntmakeXline p1 Flag))                            ;作一射线 
     (setq pts (HH:TwoEntsInters EL e 0))                    ;射线与原直线交点 
     (entdel e) 
     (cond 
       (pts 
        (setq p2 (car pts)) 
        (setq Scor (list (distance p1 p2) p1 p2)) 
       ) 
     ) 
    ) 
  ) 
  Scor 
) 
 
;;2 [功能] 弧与弧在X轴(Y轴)方向的最短距离 
;;Flag T时，X轴方向最短距离 
;;(移动距离 第二对象移动基点 移动到)或者nil(nil表示此最小移动距离为端点) 
;;(HH:TwoArcShort (car(entsel)) (car(entsel)) T)=>(12.3644 (-1334.55 2032.55 0.0) (-1346.91 2032.55)) 
(defun HH:TwoArcShort (eA1 eA2 Flag / CEN1 CEN2 ECIRCLE ELINE OBJ P2 PTS R1 R2 SCOR)   
  (setq Cen1 (HH:getArcCen eA1)) 
  (setq R1 (car Cen1)) 
  (setq Cen1 (cadr Cen1)) 
  (setq Cen2 (HH:getArcCen eA2)) 
  (setq R2 (car Cen2)) 
  (setq Cen2 (cadr Cen2)) 
  (setq eCircle (EntmakeCircle Cen2 (+ R1 R2)))                    ;以第圆中心画一圆 
  (if Flag 
    (setq p2 (list (car Cen2) (cadr Cen1))) 
    (setq p2 (list (cadr Cen2) (car Cen1))) 
  ) 
  (setq eLine (EntmakeLine Cen1 p2))                            ;圆1到圆2中心处，产生一直线 
  (setq pts (car (HH:TwoEntsInters eCircle eLine 0)))            ;新产生圆与新产生直线交点 
  (entdel eCircle) 
  (entdel eLine) 
  (if pts 
    (progn 
      (setq pts (mapcar '- pts Cen1)) 
      (setq p2 (mapcar '- Cen2 pts))                            ;圆2新中心点 
      (setq eLine (EntmakeLine Cen1 p2)) 
      (setq pts (HH:TwoEntsInters eA1 eLine 0)) 
      (cond 
        (pts 
         (setq obj (vla-copy (vlax-ename->vla-object eA2))) 
         (vla-move obj (vlax-3d-point Cen2) (vlax-3d-point p2)) 
         (setq pts (HH:TwoEntsInters eLine (entlast) 0)) 
         (entdel eLine) 
         (entdel (entlast)) 
         (cond 
           (pts 
            (setq Scor (list (distance p2 Cen2) Cen2 p2)) 
           ) 
         ) 
        ) 
        (T (entdel eLine)) 
      ) 
    ) 
  ) 
  Scor 
) 
 
;;[功能] 画圆 
(defun EntmakeCircle (p r) 
  (entmakeX (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r))) 
) 
 
;;[功能] 两多段线之间最小距离 自贡黄明儒2014.4.6 
(defun C:HH:TwoLWPShort        (/ CPT1 CPT2 E1 E2 LST P PTS1 PTS2 SS) 
  (if (and 
        (setq ss (ssget ":S" '((0 . "LWPOLYLINE")))) 
        (equal (sslength ss) 2) 
      ) 
    (progn 
      (setq e1 (ssname ss 0)) 
      (setq e2 (ssname ss 1)) 
      (setq pts1 (HH:PtLists e1))                            ;http://bbs.xdcad.net/thread-671377-1-1.html 
      (setq pts2 (HH:PtLists e2)) 
      (setq Cpt1 (HH:GetCenter3 e1)) 
      (setq Cpt2 (HH:GetCenter3 e2)) 
      (foreach X pts1 
        (setq p (vlax-curve-getClosestPointTo e2 x)) 
        (setq lst (cons (list (distance x p) x p) lst)) 
      ) 
      (foreach X pts2 
        (setq p (vlax-curve-getClosestPointTo e1 x)) 
        (setq lst (cons (list (distance x p) p x) lst)) 
      ) 
      (if Cpt1 
        (foreach X Cpt1 
          (setq p (vlax-curve-getClosestPointTo e2 x)) 
          (setq x (vlax-curve-getClosestPointTo e1 p)) 
          (setq lst (cons (list (distance x p) x p) lst)) 
        ) 
      ) 
      (if Cpt2 
        (foreach X Cpt2 
          (setq p (vlax-curve-getClosestPointTo e1 x)) 
          (setq x (vlax-curve-getClosestPointTo e2 p)) 
          (setq lst (cons (list (distance x p) p x) lst)) 
        ) 
      ) 
      (setq lst (car (HH:ssPts:Sort lst "x" 0.001))) 
      (grdraw (cadr lst) (caddr lst) 1) 
    ) 
  ) 
  lst 
) 
;;164.48 [功能] 多线上的弧段的圆心列表 
;;(HH:GetCenter3 (car(setq en(entsel)))) 
(defun HH:GetCenter3 (curve / CENLIST EP FLAG MDERIV MP PARAM SP) 
  ;;(setq curve (car (entsel))) 
  (setq param (fix (vlax-curve-getEndParam curve))) 
  (setq sp (vlax-curve-getPointAtParam curve param)) 
  (repeat param 
    (setq param (1- param)) 
    (setq Ep (vlax-curve-getPointAtParam curve param)) 
    (setq Mp (vlax-curve-getPointAtParam curve (+ param 0.5))) ;中点 
    (setq Mderiv (vlax-curve-getsecondderiv curve (+ param 0.5))) ;中点法线 
    (setq Flag (car (trans (mapcar '- Mp Ep) 0 (mapcar '- Ep sp)))) 
    (cond ((equal Flag 0) nil) 
          ((minusp Flag) 
           (setq CenList (cons (mapcar '- Mp Mderiv) CenList)) 
          ) 
          (T 
           (setq CenList (cons (mapcar '+ Mp Mderiv) CenList)) 
          ) 
    ) 
    (setq sp Ep) 
  ) 
  CenList 
) 
 
;;164.3 [功能] 多段线端点列表 
;;示例(HH:PtLists (car (entsel))) 
(defun HH:PtLists (en) 
  (mapcar 'cdr 
          (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en)) 
  ) 
) 
 
;;[功能] 两多段线X轴方向最小距离 自贡黄明儒2014.4.6 
(defun HH:XLWPShort (ss Flag / CMD1 E1 E11 E2 E21 I J LST S1 S2 SCOR SHORTC TYPE1 TYPE2) 
  ;;错误处理 
  (defun *error* (msg) 
    (vl-bt) 
    (if        *DOC* 
      (_EndUndo *DOC*)                                            ;块内图元增减 
    ) 
    (while (not (equal (getvar "cmdnames") "")) (command nil)) 
    (if        cmd1 
      (setvar "cmdecho" cmd1) 
    ) 
    (if        SHORTC 
      (setvar "SHORTCUTMENU" SHORTC) 
    ) 
    (if s1 (vl-cmdf "_.erase" s1 "")) 
    (if s2 (vl-cmdf "_.erase" s2 "")) 
    (setvar "nomutt" 0) 
    (princ "\n 出错啦!") 
    (princ) 
  ) 
  (setq e1 (ssname ss 0)) 
  (setq e2 (ssname ss 1)) 
  (vla-copy (vlax-ename->vla-object e1)) 
  (vl-cmdf "_.explode" (entlast)) 
  (setq s1 (ssget "_p")) 
  (vla-copy (vlax-ename->vla-object e2)) 
  (vl-cmdf "_.explode" (entlast)) 
  (setq s2 (ssget "_p")) 
  (repeat (setq i (sslength s1)) 
    (setq e11 (ssname s1 (setq i (1- i)))) 
    (setq type1 (cdr (assoc 0 (entget e11)))) 
    (repeat (setq j (sslength s2)) 
      (setq e21 (ssname s2 (setq j (1- j)))) 
      (setq type2 (cdr (assoc 0 (entget e21)))) 
      (cond 
        ((and (equal type1 "LINE") (equal type2 "ARC")) 
         (if (setq scor (HH:LineArcShort e21 e11 Flag)) 
           (setq lst (cons scor lst)) 
         ) 
        ) 
        ((and (equal type2 "LINE") (equal type1 "ARC")) 
          (if (setq scor (HH:LineArcShort e11 e21 Flag)) 
            (setq lst (cons scor lst)) 
          ) 
        ) 
        ((and (equal type2 "ARC") (equal type1 "ARC")) 
         (if (setq scor (HH:TwoArcShort e11 e21 Flag)) 
            (setq lst (cons scor lst)) 
          )          
        ) 
      ) 
    ) 
  ) 
  (vl-cmdf "_.erase" s1 s2 "")   
  (foreach x (HH:PtLists e1) 
    (if        (setq scor (HH:XYCurvePt e2 x Flag)) 
      (setq lst (append lst scor)) 
    ) 
  ) 
  (foreach x (HH:PtLists e2) 
    (if        (setq scor (HH:XYCurvePt e1 x Flag)) 
      (setq lst (append lst scor)) 
    ) 
  )   
  (if (setq lst (car (HH:ssPts:Sort lst "x" 0.001))) 
    (grdraw (cadr lst) (caddr lst) 1) 
  ) 
  lst 
) 
(defun C:w1 (/ SS) 
  (HH:ayOSMode nil)                                  ;关闭捕捉 
  (if (and 
        (setq ss (ssget ":S" '((0 . "LWPOLYLINE")))) 
        (equal (sslength ss) 2) 
      ) 
    (progn 
      (HH:XLWPShort ss T);X轴 
      (HH:XLWPShort ss nil);Y轴 
    )                                                             
  ) 
  (HH:ayOSMode T)                                  ;开捕捉 
  (princ) 
)

st788796 · 发表于 2014-4-7 15:00:39

你这不是X向啊

/db_自贡黄明儒_ · 发表于 2014-4-7 16:48:47

st788796 发表于 2014-4-7 15:00
你这不是X向啊

示意了X向和Y向

soly2006 · 发表于 2014-4-10 13:56:02

这个不知大师是干什么用的，如果研究出来我有福了。
作示意图，把零散的图集中起来显示和打印

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

[研讨] 两多段线在X轴方向的最短距离

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

点评

点评

点评

点评

评分

点评

点评