获得封闭多线段外围多线段

时见申

GU版主的XLRX-Curve-GetOutPoly函数在2020年更新之后处理大数据时会直接导致CAD崩溃，这个函数对于农房不动产来说使用率较高，所以索性在GU版主的框架下写了一些函数来满足自己。当然很多东西都是借鉴GU 版主的，再次感谢GU版主。
;(setq ss (ssget))
;(XLRX-Curve-GetOutPoly22 ss aa 0.03 pp)
;获得outline的选择集，但是选择集有可能为nil 其中参数aa pp 为无用参数
;注意：两条多线段交点处必须都要有端点，不然程序会出错
(defun XLRX-Curve-GetOutPoly22(ss aa full pp / ty_lst hd_ss)
        (setq ty_lst (XLRX-PickSet->List ss))
        (setq inter_lst  (IntersGroup ty_lst))
        (setq hd_ss (ssadd))
        (foreach name inter_lst
                (if (>= (length name) 2)
                        (progn
                                (setq hb_pl_pts (ty_lst->pl name full))
                                (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length hb_pl_pts)))
                   (mapcar '(lambda (pt)(cons 10 pt)) hb_pl_pts))
        )
                                (vla-put-Closed (vlax-ename->vla-object (entlast)) :vlax-true)
                    (ssadd (entlast) hd_ss)
                        )
                )
        )
        (if (and hd_ss (>= (sslength hd_ss) 1))
                hd_ss
                nil
        )
)

;==============================================================================================================
;根据图元列表获得具有交点的图元列表
(defun IntersGroup  (LST / INTERLST ENT LL RESULT)
    (defun interlst  (a l / r)
      (foreach en  l
              (if (>
                                                        (length
                                                                (vlax-invoke (vlax-ename->vla-object a) 'IntersectWith (vlax-ename->vla-object en) acExtendNone))
                                                        3
                                                )
                 (setq r (cons en r))
              )
            )
      (if r
                                (append (list a)
                                        (apply 'append (mapcar '(lambda (x) (interlst x (vl-remove x l))) r))
              )
              (list a)
            )
    )
    (while lst
      (setq
                                ent        (car lst)
              lst        (cdr lst)
            )
      (setq ll (interlst ent lst))
      (setq result (cons ll result))
      (foreach a  ll
              (setq lst (vl-remove a lst))
            )
    )
    (mapcar '(lambda (x) (GXL-LISTDUMPATOM x)) result)
  )


;;;除重复元素，参数：表
(defun gxl-ListDumpAtom(Lst)
  (if Lst
    (cons (car Lst) (gxl-ListDumpAtom (vl-remove (car Lst) (cdr Lst))))
        )
)



;==============================================================================================
;(setq ss (ssget))
;(setq lst (XLRX-PickSet->List ss))
;(setq ptss_lst (ty_lst->pl lst 0.03))
; (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length ptss_lst)))
;      (mapcar '(lambda (pt)(cons 10 pt)) ptss_lst ))
;  )
;获得图元列表合并后的pl线点列表
(defun ty_lst->pl(lst full / f_ty lst pts1 pts2)
        (setq f_ty (car lst))
        (setq lst (vl-remove f_ty lst))
        (setq pts1 (vl-remove nil (mapcar '(lambda (x)(if(= (car x) 10)(cdr x))) (entget f_ty))))
        (foreach name lst
                (setq pts2 (vl-remove nil (mapcar '(lambda (x)(if(= (car x) 10)(cdr x))) (entget name))))
                (setq pts1 (hd_pl_lst pts1 pts2 full))
        )
        pts1
)



;获得两个点列表的公共点，并第一个列表的顺序号加进去公共点。如果存在容差值，则公共点加入的是第一个表的值
;(setq full 0.03)
(defun hd_gglst(vlist1 vlist2 full / n k fir_pt soc_pt gg_lst)
        (setq gg_lst '())
        (setq n 0)
        (repeat (length vlist1)
                (setq k 0)
                (setq fir_pt (nth n vlist1))
                (repeat (length vlist2)
                        (setq soc_pt (nth k vlist2))
                        (if (equal fir_pt soc_pt full)
                                (setq gg_lst (append gg_lst (list (cons n fir_pt))))
                        )
                        (setq k (1+ k))
                )
                (setq n (1+ n))
        )
        gg_lst
)

;获得两个点列表合并后的pl列表
(defun hd_pl_lst (lst1 lst2 full / hd_lst px_lst hd_pd_lst pxh_gg_lst ggpts f_zz_pt hd_lst1 hd_lst2 qcggd_lst1 qcggd_lst2)
        (if (not (XLRX-clockwisep lst1))
                (setq lst1 (reverse lst1))
        )
        (if (not (XLRX-clockwisep lst2))
                (setq lst2 (reverse lst2))
        )
        (setq px_lst (hd_gglst lst1 lst2 full))
  (setq hd_pd_lst (pd_lx_lst px_lst))
        (if (not (car hd_pd_lst))
                (setq px_lst (hd_zh_lst (assoc (cadr hd_pd_lst) px_lst) px_lst full))
        )
        (setq pxh_gg_lst (mapcar '(lambda (x) (cdr x)) px_lst))
        (setq ggpts (list (car pxh_gg_lst) (last pxh_gg_lst)))
        (setq f_zz_pt (cdr (car px_lst)))
        (setq hd_lst1 (vl-remove nil (hd_zh_lst f_zz_pt lst1 full)))
        (setq hd_lst2 (vl-remove nil (hd_zh_lst f_zz_pt lst2 full)))
        (setq qcggd_lst1 (qcggd_lst hd_lst1 pxh_gg_lst full))
        (setq qcggd_lst2 (qcggd_lst hd_lst2 pxh_gg_lst full))
        (cond
                ((pl_nj_pl hd_lst2 hd_lst1) (setq hd_pl_lst_pts hd_lst2))
                ((pl_nj_pl hd_lst1 hd_lst2)(setq hd_pl_lst_pts hd_lst1))
                ((and qcggd_lst1) (setq hd_pl_lst_pts (append qcggd_lst1 (list (car ggpts)) qcggd_lst2 (list (cadr ggpts)))))
                ((and (not qcggd_lst1) (not qcggd_lst2)) (setq hd_pl_lst_pts hd_lst1))
                ((and (not qcggd_lst1) qcggd_lst2) (hd_pl_lst lst2 lst1 full))
        )
)

; (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length hd_pl_lst_pts)))
;      (mapcar '(lambda (pt)(cons 10 pt)) hd_pl_lst_pts ))
;  )
;
;获得公共点列表是否按照顺序排列，返回(t nil)按照顺序, 返回(nil 6),从(assoc 6 px_lst)出现跳号
(defun pd_lx_lst(px_lst / n pd_xu pd_zz f_pt s_pt)
        (setq n 0 pd_xu nil pd_zz t)
        (while (and pd_zz (< n (- (length px_lst) 1)))
                (setq f_pt (nth n px_lst))
                (setq s_pt (nth (1+ n) px_lst))
                (if (/= (1+ (car f_pt)) (car s_pt))
                        (progn
                                (setq pd_zz nil)
                                (setq pd_xu (car s_pt))
                        )
                )
                (setq n (1+ n))
        )
        (setq hd_pd_lst (list pd_zz pd_xu))
)


;带有容差的member
(defun LI_memb (ele Lst diff / len cnt Found)
        (setq hd_pt nil)
  (foreach name Lst
                (if (equal name ele diff)
                        (setq hd_pt name)
                )
        )
        (setq hd_lst (member hd_pt Lst))
)

;重新组合列表，使得按照eles作为第一个原子
(defun hd_zh_lst(eles lst full / f_bf_lst hd_lsttt)
        (setq f_bf_lst (LI_memb eles lst full))
        (foreach name lst
                (foreach x f_bf_lst
                        (if (equal x name full)
                                (setq lst (vl-remove name lst))
                        )
                )
        )
        (setq hd_lsttt (append f_bf_lst lst))
)


;带容差的去除两个列表的重复点，返回第一个表去除后的列表
(defun qcggd_lst (lst1 lst2 full / )
        (foreach name lst1
                (foreach x lst2
                        (if (equal x name full)
                                (setq lst1 (vl-remove name lst1))
                        )
                )
        )
        lst1
)


;判断列表1是否包含列表2
(defun pl_nj_pl (lst1_0 lst2_0 / pd_lst00 lst2_0 lst1_0)
        (setq pd_lst00 '())
        (foreach name lst2_0
                (if (XLRX-Point-IsInPoly1 name lst1_0)
                        (setq pd_lst00 (cons t pd_lst00))
                        (setq pd_lst00 (cons nil pd_lst00))
                )
        )
        (if (not (vl-remove t pd_lst00))
                t
        )
)

时见申

上传不了图片，大概描述一些吧。这个程序主要是针对有两个以上重合端点的闭合多线段，获得这些多线段的外围多线段。

xujinhua

测绘同行，谢谢你

zhangkui9070

挺好，感谢分享

qazxswk

运行了一下，还缺函数。