找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1285|回复: 2

[拓扑] 【拓扑处理】多边形(面)延伸到多边形

[复制链接]

已领礼包: 51个

财富等级: 招财进宝

发表于 2018-12-25 13:08:50 | 显示全部楼层 |阅读模式
  • 插件名称 : 面延伸
  • 作  者 : Lispboy
  • 运行环境 :XDRX API 晓东工具箱 
  • 发布时间 :2018-12-25
  • 命令名称 :xdtb_polygonextend
  • 插件介绍 :【拓扑处理】多边形(面)延伸到多边形
  • 备  注 : (点击图片可以放大)
(点击图片可以放大)

晓东温馨提示 1、运行环境为 晓东工具箱XDRX API 的插件,请下载最新版本的 晓东工具箱XDRX API开发环境 一键安装
2、在ACAD中如何加载插件,请看 论坛插件使用方法
3、如果您有要求需要定制插件,请到 编程申请 论坛发帖求助

插件详细内容

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

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

×

处理两个封闭的多边形,延伸其中的一个贴合到另外一个

  1. (defun c:xdtb_polygonextend (/ #constantwidth data data1 data2 e e1 e2 info int1 int2 ints inx1 inx2
  2.                              ln1 ln2 oninx1 oninx2 p1 p2 pmid1 pmid2 pt pts sub1 sub2 tf x xl1 xl2 y
  3.                             )
  4.   (defun _near (pt ints)
  5.     (setq pts (mapcar '(lambda (x) (list (distance x pt) x)) ints)
  6.           pts (vl-sort pts '(lambda (x y) (< (car x) (car y))))
  7.     )
  8.     (last (car pts))
  9.   )
  10.   (defun _select (info / tf e1 p1 inx1 oninx1 ln1)
  11.     (setq tf t)
  12.     (while (and tf
  13.                 (setq e1 (xdrx_entsel
  14.                            (xdrx_prompt "\n拾取延伸边" info "(直线段)<退出>:" t)
  15.                            '((0 . "*polyline") (-4 . "&=") (70 . 1))
  16.                          )
  17.                 )
  18.            )
  19.       (setq p1 (trans (cadr e1) 1 0))
  20.       (setq e1 (car e1))
  21.       (setq inx1 (xdrx_getpropertyvalue e1 "nearindex" p1))
  22.       (setq oninx1 (xdrx_polyline_onsegat e1 p1))
  23.       (setq p1 (xdrx_polyline_getpointat e1 inx1))
  24.       (if (setq ln1 (xdrx_polyline_getlinesegat e1 oninx1 t))
  25.         (setq tf nil)
  26.         (xdrx_prompt "\n没有选中直线段,重试...")
  27.       )
  28.     )
  29.     (if e1
  30.       (list e1 p1 inx1 oninx1 ln1)
  31.     )
  32.   )
  33.   (xdrx_begin)
  34.   (if (and (apply 'and
  35.                   (mapcar 'set '(e1 p1 inx1 oninx1 ln1) (_select 1))
  36.            )
  37.            (apply 'and
  38.                   (mapcar 'set '(e2 p2 inx2 oninx2 ln2) (_select 2))
  39.            )
  40.            (equal e1 e2)
  41.            (setq e (xdrx_entsel
  42.                      "\n拾取目标多段线<退出>:"
  43.                      '((0 . "*polyline") (-4 . "&=") (70 . 1))
  44.                    )
  45.            )
  46.            (setq pt (trans (cadr e) 1 0))
  47.            (setq e (car e))
  48.            (setq pmid1 (xdrx_curve_getclosestpoint e1 pt))
  49.            (setq pmid2 (XD:Curve:OppositePt e1 pmid1))
  50.            (setq int1 (xdrx_get_inters ln1 e 1))
  51.            (setq int2 (xdrx_get_inters ln2 e 1))
  52.            (setq int1 (_near p1 int1))
  53.            (setq int2 (_near p2 int2))
  54.            (setq sub1 (xd::curve:getsub e int1 int2 pt))
  55.            (setq sub2 (xd::curve:getsub e1 p1 p2 pmid2))
  56.            (setq data1 (xdrx_getpropertyvalue sub1 "get"))
  57.            (setq data2 (xdrx_getpropertyvalue sub2 "get"))
  58.            (setq xl1 (xdge::constructor "kline3d" ln1))
  59.            (setq xl2 (xdge::constructor "kline3d" ln2))
  60.       )
  61.     (progn (cond ((or (equal (xdge::getpropertyvalue xl1 "distanceto" (caar data1))
  62.                              (xdge::getpropertyvalue xl1 "distanceto" (caar data2))
  63.                              1e-3
  64.                       )
  65.                       (equal (xdge::getpropertyvalue xl2 "distanceto" (caar data1))
  66.                              (xdge::getpropertyvalue xl2 "distanceto" (caar data2))
  67.                              1e-3
  68.                       )
  69.                   )
  70.                   (setq data (mapcar 'append
  71.                                      data1
  72.                                      (mapcar 'cdr (mapcar 'reverse (mapcar 'cdr data2)))
  73.                              )
  74.                   )
  75.                  )
  76.                  ((or (equal (xdge::getpropertyvalue xl1 "distanceto" (caar data1))
  77.                              (xdge::getpropertyvalue xl1 "distanceto" (last (car data2)))
  78.                              1e-3
  79.                       )
  80.                       (equal (xdge::getpropertyvalue xl2 "distanceto" (caar data1))
  81.                              (xdge::getpropertyvalue xl2 "distanceto" (last (car data2)))
  82.                              1e-3
  83.                       )
  84.                   )
  85.                   (setq data (mapcar 'append
  86.                                      data1
  87.                                      (mapcar 'reverse
  88.                                              (mapcar 'cdr (mapcar 'reverse (mapcar 'cdr data2)))
  89.                                      )
  90.                              )
  91.                   )
  92.                  )
  93.            )
  94.            (xdrx_getpropertyvalue e1 "constantwidth")
  95.            (xdrx_setpropertyvalue
  96.              e1 "set" data "closed" t "constantwidth" #constantwidth
  97.             )
  98.     )
  99.   )
  100.   (xdrx_end)
  101.   (princ)
  102. )


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

已领礼包: 3个

财富等级: 恭喜发财

发表于 2019-11-30 22:44:22 | 显示全部楼层
功能很强大 ,收藏
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2019-12-1 00:12:15 | 显示全部楼层
功能很强大 ,收藏
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2024-3-29 20:12 , Processed in 0.377214 second(s), 35 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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