获得封闭多线段外围多线段
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 enl
(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 all
(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
)
)
上传不了图片，大概描述一些吧。这个程序主要是针对有两个以上重合端点的闭合多线段，获得这些多线段的外围多线段。 测绘同行，谢谢你 挺好，感谢分享:hug: 运行了一下，还缺函数。
页:
[1]