设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 37|回复: 2

[曲线] (XD::Polyline:Append-half-Circle)在多段线上一点增加指定半径的半圆

[复制链接]

已领礼包: 40个

财富等级: 招财进宝

发表于 4 天前 | 显示全部楼层 |阅读模式
函数发布
函数名称: XD::Polyline:Append-half-Circle
调用格式: (XD::Polyline:Append-half-Circle ent pnt radius info)
参数说明: ent ------ 曲线(LINE,ARC,CIRCLE,ELLIPSE,SPLINE,POLYLINE)
pnt ------ 曲线上点
radius ---- 半径值
info ---- 字符串,半径太大绘制不了打印提示,NIL,静默
返回值: T or nil
函数简介: 在多段线上一点增加指定半径的半圆
函数来源: 二次修改
函数作者:
适用版本: XDRX API 
最后更新时间: 2020-05-23
备注: -
演示图片:

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

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

x
本帖最后由 newer 于 2020-5-23 14:10 编辑

  1. (defun xd::polyline:append-half-circle (e     pnt   radius info        /
  2.                                         b1    b2    bulge cir        ept
  3.                                         g1    g2    garc1 garc2        ints
  4.                                         inx   inxs  midp  p1        p3
  5.                                         r     seg   segs  spt        tf
  6.                                         typ   v            x          y        yno
  7.                                        )
  8.   (xdrx-curve->polyline e)
  9.   (setq pnt (xdrx-curve-getclosestpoint e pnt))
  10.   (setq tf t)
  11.   (setq        inx (car (xdrx-getpropertyvalue e "onSegat" pnt))
  12.         typ (xdrx-polyline-segtype e inx)
  13.         spt (xdrx-polyline-getpointat e inx)
  14.         ept (xdrx-polyline-getpointat e (1+ inx))
  15.   )
  16.   (if (or (and (= typ "kArc")
  17.                (setq cir (xdrx-getpropertyvalue e "ArcSegAt" inx))
  18.           )
  19.           (and (= typ "kLine")
  20.                (= (xdrx-polyline-segtype e (1- inx)) "kArc")
  21.                (setq cir (xdrx-getpropertyvalue e "ArcSegAt" (1- inx)))
  22.                (xdge::getpropertyvalue cir "ison" pnt)
  23.           )
  24.       )
  25.     (progn (setq r (xdrx-getpropertyvalue cir "radius"))
  26.            (if (not (< radius (/ r 3.0)))
  27.              (progn (xdrx-prompt info)
  28.                     (setq tf nil)
  29.              )
  30.            )
  31.            (xdge::free cir)
  32.     )
  33.   )
  34.   (if tf
  35.     (progn
  36.       (setq cir         (xdge::constructor "kcircarc3d" pnt '(0 0 1.0) radius)
  37.             ints (xdrx-get-inters cir e)
  38.             v         (xdrx-curve-getfirstderiv e pnt)
  39.       )
  40.       (xdge::free cir)
  41.       (if (xdrx-vector-iscodirectional v '(1 0 0) (/ pi 2.0))
  42.         (setq bulge -1.0)
  43.         (setq bulge 1.0)
  44.       )
  45.       (if (= (length ints) 2)
  46.         (progn
  47.           (if (= (xdrx-polyline-segtype e inx) "kArc")
  48.             (progn (setq inxs  (vl-sort
  49.                                  (mapcar
  50.                                    '(lambda (x)
  51.                                       (list (xdrx-curve-getparamatpoint e x) x)
  52.                                     )
  53.                                    ints
  54.                                  )
  55.                                  '(lambda (x y) (< (car x) (car y)))
  56.                                )
  57.                          p1    (cadar inxs)
  58.                          p3    (cadadr inxs)
  59.                          garc1 (xdrx-polyline-getarcsegat e inx t)
  60.                          garc2 (xdge::copy garc1)
  61.                          g1    (xdge::setpropertyvalue garc1 "setinterval" spt p1)
  62.                          midp  (xdrx-getpropertyvalue g1 "midpoint")
  63.                          b1    (xdrx-getpropertyvalue g1 "bulge")
  64.                          b1    (if (XD::Clockwise-p spt midp p1)
  65.                                  (- b1)
  66.                                  b1
  67.                                )
  68.                          g2    (xdge::setpropertyvalue
  69.                                  garc2
  70.                                  "setinterval"
  71.                                  (cadadr inxs)
  72.                                  ept
  73.                                )
  74.                          b2    (xdrx-getpropertyvalue g2 "bulge")
  75.                          midp  (xdrx-getpropertyvalue g2 "midpoint")
  76.                          b2    (if (XD::Clockwise-p p3 midp ept)
  77.                                  (- b2)
  78.                                  b2
  79.                                )
  80.                    )
  81.               (xdge::free garc1 garc2 g2)
  82.             )
  83.           )
  84.           (xdrx-polyline-addvertexat e (1+ inx) (car ints))
  85.           (setq seg (xdrx-getpropertyvalue e "onsegat" pnt))
  86.           (xdrx-polyline-addvertexat e (1+ (car seg)) (cadr ints))
  87.           (setq
  88.             segs (vl-sort
  89.                    (list (xdrx-curve-getparamatpoint e (car ints))
  90.                          (xdrx-curve-getparamatpoint e (cadr ints))
  91.                    )
  92.                    '(lambda (x y) (< x y))
  93.                  )
  94.           )
  95.           (xdrx-setpropertyvalue e "bulgeat" (list (car segs) bulge))
  96.           (xdrx-setpropertyvalue e "bulgeat" (list inx b1))
  97.           (xdrx-setpropertyvalue e "bulgeat" (list (cadr segs) b2))
  98.         )
  99.       )
  100.     )
  101.   )
  102. )

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

已领礼包: 84个

财富等级: 招财进宝

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

使用道具 举报

已领礼包: 86个

财富等级: 招财进宝

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2020-5-27 07:48 , Processed in 0.146403 second(s), 38 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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