设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › 开源函数库 › (XD::Geom:pathIsLand)获得两个嵌套多边形中间的海洋部 ...
返回列表 发新帖
查看: 2892|回复: 11

[几何] (XD::Geom:pathIsLand)获得两个嵌套多边形中间的海洋部分（海->陆地）

[复制链接]
Lispboy

已领礼包: 51个

财富等级: 招财进宝
发表于 2013-7-27 22:14:01 | 显示全部楼层 |阅读模式
函数发布
函数名称: XD::Geom:pathIsLand
调用格式: (XD::Geom:pathIsLand e1 e2)
参数说明: 参数：
e1---内部多边形实体(孤岛)
e2---外部多边形实体
返回值: 表（两块陆地）
函数简介: 获得两个嵌套多边形中间的海洋部分（海-》陆地）
函数来源: 原创
函数作者: Lispboy
适用版本: XDRX API 
最后更新时间: 2013-07-27
备注: -
演示图片:

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

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

×
本帖最后由 Lispboy 于 2013-7-28 02:29 编辑

  1. ;|
  2. 获得两个嵌套多边形中间的海洋部分（海-》陆地）
  3. 参数：
  4.   e1---内部多边形
  5.   e2---外部多边形
  6. 返回值：
  7.   表（两块陆地）
  8. |;
  9. (defun XD::Geom:pathIsLand (e1 e2 / e3 e4 e5 e6 el p1 p2 pts1 pts2 ss ss3 x)
  10.   (xdrx_document_ucson)
  11.   (if (and
  12.         (/= e1 e2)
  13.         (setq pts1 (xdrx_entity_getStretchPoint e1)
  14.               pts2 (xdrx_entity_getStretchPoint e2)
  15.         )
  16.         (>= (length pts1) 3)
  17.         (>= (length pts2) 3)
  18.         (XD::Pnts:IsInPolyWithPnts pts1 pts2)
  19.       )
  20.     (progn
  21.       (setq p1 (car (XD::PNTS:MinX->MinY pts1 1e-5))
  22.             p2 (car (XD::PNTS:MinX->MinY pts2 1e-5))
  23.             pts1 (XD::PntS:UnClockWise pts1 p1 1e-5)
  24.             pts2 (XD::PntS:UnClockWise pts2 p2 1e-5)
  25.       )
  26.       (if (vl-some '(lambda (x)
  27.                       (XD::Pnt:IsOn x pts2)
  28.                     ) pts1
  29.           )
  30.         (progn
  31.           (setq ss3 (xdrx_curve_subtract e2 e1 0.0))
  32.           (setq el (XD::SS:Ents ss3))
  33.           (if (> (length el) 2)
  34.             (progn
  35.               (entdel (car el))
  36.               (entdel (last el))
  37.               (list (cadr el) (caddr el))
  38.             )
  39.             el
  40.           )
  41.         )
  42.         (progn
  43.           (setq ss (ssadd))
  44.           (ssadd e1 ss)
  45.           (ssadd e2 ss)
  46.           (xdrx_line_make (trans (car pts1) 1 0) (trans (car pts2) 1 0))
  47.           (ssadd (setq e3 (entlast))
  48.                  ss
  49.           )
  50.           (xdrx_line_make (trans (caddr pts1) 1 0) (trans (caddr pts2) 1 0))
  51.           (ssadd (setq e4 (entlast))
  52.                  ss
  53.           )
  54.           (xdrx_geom_bpoly (xdrx_midp (last pts1) (last pts2)) ss)
  55.           (setq e5 (entlast))
  56.           (xdrx_geom_bpoly (xdrx_midp (cadr pts1) (cadr pts2)) ss)
  57.           (setq e6 (entlast))
  58.           (entdel e3)
  59.           (entdel e4)
  60.           (list e5 e6)
  61.         )
  62.       )
  63.     )
  64.   )
  65. )


测试代码：

  1. (defun c:t5()
  2.    (if (and (setq e1 (car (entsel)))
  3.             (setq e2 (car (entsel)))
  4.        )
  5.        (progn
  6.           (XD::Begin)
  7.           (xdrx_document_setPrec 3.0 1)
  8.           (setq el (XD::Geom:PathIsland e1 e2))
  9.           (setq i 1)
  10.           (foreach n el
  11.             (setq pts (xdrx_entity_getstretchpoint n))
  12.             (apply 'xdrx_grdraw (append (list i 3) pts))
  13.             (setq i (1+ i))
  14.           )
  15.           (XD::End)
  16.        )
  17.    )
  18.    (princ)
  19. )


海洋

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

拉契
发表于 2014-3-17 16:04:15 | 显示全部楼层
虽然不知道什么地方用到这个 但是感觉挺复杂的！学习
{:soso_e179:}
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 0 反对 1

使用道具 举报

wowan1314
发表于 2013-7-27 23:36:39 | 显示全部楼层
我瞎耍。。
下面代码只适应于演示。
  2. (defun enbox (ename / ll ur p2 p4)
  3.     (vla-getboundingbox (vlax-ename->vla-object ename) 'll 'ur)
  4.     (setq ll (vlax-safearray->list ll)ur (vlax-safearray->list ur))
  5.     (setq p4 (list (car ll)(cadr ur))p2 (list (car ur)(cadr ll)))
  6.     (list ll p2 ur p4)
  7. )
  8. (defun c:t11 ( / e1 e2 e11 e22 e111 e222)
  9.     (setq e11 (car(entsel)) e22 (car(entsel)))
  10.     (setq e1 (enbox e11) e2 (enbox e22))
  11.     (command "line" (car e1) (car e2) "")
  12.     (setq e11 (entlast))
  13.     (command "line" (caddr e1) (caddr e2) "")
  14.     (setq e22 (entlast))
  15.     (command "boundary"  (mapcar '+ (last e1) '(55 -55)) "")
  16.     ;(bpoly (mapcar '+ (last e1) '(1 -1)))怎么不好使？
  17.     (setq e222 (entlast))
  18.     (command "boundary"  (mapcar '+ (cadr e1) '(-55 55)) "")
  19.     (setq e111 (entlast))
  20.     (entdel e11)(entdel e22)
  21.     (sssetfirst nil (ssadd e111 (ssadd e222 (ssadd))))
  22. )
123.gif

点评

Lispboy
葛老，多边形要是斜的呢？  详情 回复 发表于 2013-7-27 23:50

评分

参与人数 1D豆 +5 收起 理由
Lispboy + 5 很给力!经验；技术要点；资料分享奖！

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Lispboy

已领礼包: 51个

财富等级: 招财进宝
 楼主| 发表于 2013-7-27 23:50:51 | 显示全部楼层
wowan1314 发表于 2013-7-27 23:36
我瞎耍。。
下面代码只适应于演示。

葛老，多边形要是斜的呢？

点评

wowan1314
仔细看了下，我们的思路好像都差不多。 只是不知xdrx_geom_bpoly效果如何.是否也有精度的bug?  发表于 2013-7-28 00:12
wowan1314
话说 bpoly函数或者boundary命令对于点离边界太近了就不认了？！ 就像上面的代码偏移20都不行。必须偏移多些。而且跟拾取框大小都有关系。关闭捕捉也没用。  详情 回复 发表于 2013-7-28 00:04
wowan1314
代码只适应演示。呵呵。 无聊写着玩。。  发表于 2013-7-27 23:53
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

wowan1314
发表于 2013-7-28 00:04:29 | 显示全部楼层
本帖最后由 wowan1314 于 2013-7-28 00:20 编辑
Lispboy 发表于 2013-7-27 23:50
葛老，多边形要是斜的呢？

话说 bpoly函数或者boundary命令对于点离边界太近了就不认了？！
就像上面的代码偏移20都不行。必须偏移多些。而且跟拾取框大小都有关系。关闭捕捉也没用。
这两函数的点看来最好是由用户自定，lisp内部指定容易留下隐患。

用下面的代码代替包围盒函数会好些。
  2. (mapcar 'cdr(vl-remove-if
  3.         '(lambda(x)(/= (car x) 10))
  4.         (entget (car(entsel))
  5.         )
  6.     )
  7. )

点评

Lispboy
xdrx_geom_bpoly 可不是bpoly ，屏幕看不到也能求出结果。你可以试试。 代码修改了，多适用了几种情况，好像全了？看下一楼的演示。 不能用BOX，因为多边形可能是斜的。  详情 回复 发表于 2013-7-28 01:01
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Lispboy

已领礼包: 51个

财富等级: 招财进宝
 楼主| 发表于 2013-7-28 01:01:55 | 显示全部楼层
本帖最后由 Lispboy 于 2013-7-28 01:05 编辑
wowan1314 发表于 2013-7-28 00:04
话说 bpoly函数或者boundary命令对于点离边界太近了就不认了？！
就像上面的代码偏移20都不行。必须偏 ...

xdrx_geom_bpoly 可不是bpoly ，屏幕看不到也能求出结果。另外xdrx_geom_bpoly 能对选择集进行操作，你可以试试。

代码修改了，多适用了几种情况，好像全了？看下一楼的演示。

不能用BOX，因为多边形可能是斜的。

点评

wowan1314
呵呵！ 我又来耍了。。 下面的代码只为了演示。。 。 且适用于演示。  详情 回复 发表于 2013-7-28 23:27
wowan1314
呵呵！ 下图这个情况呢？  详情 回复 发表于 2013-7-28 22:15
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

清风明月10
发表于 2013-7-28 13:12:12 | 显示全部楼层
谢谢楼主的分享！很有用啊。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

wowan1314
发表于 2013-7-28 22:15:42 | 显示全部楼层
本帖最后由 wowan1314 于 2013-7-29 18:47 编辑
Lispboy 发表于 2013-7-28 01:01
xdrx_geom_bpoly 可不是bpoly ，屏幕看不到也能求出结果。另外xdrx_geom_bpoly 能对选择集进行操作，你可 ...

呵呵！  
下图这个情况呢？
测试了下DX-API的 xdrx_geom_bpoly比lisp自带的好用。 没有精度的bug。
(bpoly (mapcar '+ '(1 1)(getpoint)));;选边界上的点。然后说点在对象上，无法成功。
(xdrx_geom_bpoly (mapcar '+ '(1 1)(getpoint)));;而这句可以运行。

同时测试了XD-API的删除比VLA-DELETE函数快不少。
XD-API的矩阵比lisp的矩阵函数 效率也要高不少。LISP矩阵转换比VLA方法转换快一点点。

呵呵。 真心动ing.


未命名.jpg
未命名1.jpg
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

wowan1314
发表于 2013-7-28 23:27:16 | 显示全部楼层
本帖最后由 wowan1314 于 2013-7-28 23:36 编辑
Lispboy 发表于 2013-7-28 01:01
xdrx_geom_bpoly 可不是bpoly ，屏幕看不到也能求出结果。另外xdrx_geom_bpoly 能对选择集进行操作，你可 ...

呵呵！ 我又来耍了。。

下面的代码只为了演示。。 。 且仅适用于演示。
  2. (defun enbox1(e)(mapcar 'cdr(vl-remove-if '(lambda(x)(/= (car x) 10))(entget e))))
  3. (defun minpt (A B)(mapcar '* '(0.5 0.5)(mapcar '+ A B)))
  4. (defun MKLINE (X Y)(command "line" X Y "")(entlast))
  5. (defun c:t11 ( / e1 e2 e11 e22 e111 e222 ss a1 a2 a11 a22)
  6.     (setq e11 (car(entsel)) e22 (car(entsel)) ss (ssadd e11 (ssadd e22 (ssadd)))
  7.           a1 (enbox1 e11) a2(enbox1 e22)
  8.         a11 (minpt (car a1) (caddr a1))
  9.         a22 (minpt (car a2) (caddr a2))
  10.           e1 (vl-sort a1 '(lambda(x y)(<(angle x a11)(angle y a11))))
  11.           e2 (vl-sort a2 '(lambda(x y)(<(angle x a22)(angle y a22))))
  12.           E11 (MKLINE (cadr e1) (cadr e2))
  13.           E22 (MKLINE (last e1) (last e2))
  14.           e222 (bpoly(mapcar '- (minpt (car e1) (car e2))'(-200 -200)) ss '(1 0))
  15.           e111 (bpoly(mapcar '- (minpt (caddr e1) (caddr e2))'(200 200)) ss '(1 0))
  16.      )
  17.     (entdel e11)(entdel e22)
  18.     (sssetfirst nil (ssadd e111 (ssadd e222 (ssadd))))
  19. )
123.gif
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-2 15:22 , Processed in 0.296114 second(s), 62 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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