434939575 发表于 2015-7-30 10:48:21

请求功能完善线段之间增加线连接

本帖最后由 434939575 于 2015-8-3 10:13 编辑

本程序想要达到最右边的连线效果，颜色不要那样子。自己只能弄出中间的效果。望大家多多帮助。谢谢！

(defunc:tt()

(setq ss(ssget))
(tmp_2 ss)
)

;;; 功能水平线端点增线连线
(defun tmp_2 (ss / one_pt:ab pt_jion sort_y<two_pt:a two_pt:ab)
(setq lis_app nil)
    (setq sort_y< (tmp_1 ss))
   ;(setq pa (cadar sort_y<));第一点
(while (/= sort_y< nil)
    (setq one_pt:ab (cdar sort_y<))
    (setq two_pt:ab (reverse (cdadr sort_y<)))
    (setq two_pt:a (car two_pt:ab))
    (setq two_pt:a (cadr two_pt:ab))
    (if(/= pt_jion nil)
      (progn
(if (/= two_pt:a nil)
    (setqlis> (list pt_jion
         (car one_pt:ab)
         (cadr one_pt:ab)
         (car two_pt:ab)
         (cadr two_pt:ab)
         )
    )
    (setq lis> (list pt_jion (car one_pt:ab) (cadr one_pt:ab)))
) ;if
      ) ;progn <<
      (progn (if (/= two_pt:a nil)
         (setq lis> (list(car one_pt:ab)
      (cadr one_pt:ab)
      (car two_pt:ab)
      (cadr two_pt:ab)
      )
         )
         (setq lis> (list (car one_pt:ab) (cadr one_pt:ab)))
       ) ;if
      ) ;progn <<
    ) ;if
    (setq sort_y< (cddr sort_y<))
    (setq pt_jion two_pt:a)
    (setq lis_app (append lis_app lis>))
);while
(entmake_pline lis_app)
)    ;end

;;;********************************
(defun entmake_pline (lst)
(entmake (append (list '(0 . "LWPOLYLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbPolyline")
       (cons 90 (length lst))
       )
       (mapcar '(lambda (pt) (cons 10 pt)) lst)
   )
)
)


;;水平线-名字 2端点 从下到上排序
(defun tmp_1 (ss       /
               e1       e2
               ii       na+pt>ab
               na+pt>ab+
               name    pt_lis
               pta   pta_x
               ptb   ptb_x
               vl_y<
                )
(setq na+pt>ab+ nil)
(setq ii 0)
(repeat (sslength ss)
    (setq name (ssname ss ii)
    ii   (1+ ii)
    )
    (setq pta (vlax-curve-getstartpoint name))
    (setq ptb (vlax-curve-getendpoint name))
    (setq pta_x (car pta))
    (setq ptb_x (car ptb))
    (if(< pta_x ptb_x) ;水平线排序
      (setq pt_lis (list pta ptb))
      (setq pt_lis (list ptb pta))
    )
    (setq na+pt>ab (append (list name) pt_lis))
    (setq na+pt>ab+ (append (list na+pt>ab) na+pt>ab+))
);repeat
(setq
    vl_y< (vl-sort
      na+pt>ab+
      (function (lambda (e1 e2) (< (cadadr e1) (cadadr e2))))
    )
)
)    ;end


llsheng_73 发表于 2015-7-30 13:29:55

没有仔细看你是怎么做到中间这个图的结果的，只是比较了中间和右边两个图的区别，要做到最右边的结果
个人认为可以在你目前能做出中间图的基础上按下边的方法进行处理
选出所有待处理线段(按y坐标从小至大排序)
（while 待处理线段表非空
从第一条线段开始处理
(如果该线段与第二条线段端点间距离过大，不进行连接处理，否则进行连接)
   (将处理过的线段从待处理线段中去掉)
）

hehoubin 发表于 2015-7-30 13:38:59

处理到第3个的可能性很小。

77077 发表于 2015-8-3 09:50:45

可不可以将直线按长度分组呢？

434939575 发表于 2015-8-3 10:11:52

77077 发表于 2015-8-3 09:50 static/image/common/back.gif
可不可以将直线按长度分组呢？

分组倒是可以，我还处理不好
页: [1]
查看完整版本: 请求功能完善线段之间增加线连接