明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 241|回复: 2

[经验] 获得封闭多线段外围多线段

[复制链接]
发表于 2021-6-4 09:51 | 显示全部楼层 |阅读模式
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
        )
)

评分

参与人数 1明经币 +1 收起 理由
USER2128 + 1 赞一个!

查看全部评分

 楼主| 发表于 2021-6-4 09:58 | 显示全部楼层
上传不了图片,大概描述一些吧。这个程序主要是针对有两个以上重合端点的闭合多线段,获得这些多线段的外围多线段。
发表于 2021-6-10 10:06 | 显示全部楼层
测绘同行,谢谢你
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2020 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2021-6-16 05:24 , Processed in 0.899032 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表