设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 488|回复: 3

[工具] 【工具】动态 两点绘制圆弧

[复制链接]

已领礼包: 40个

财富等级: 招财进宝

发表于 2020-7-6 14:15:31 | 显示全部楼层 |阅读模式
  • 插件名称 : 两点圆弧
  • 作  者 : newer
  • 运行环境 :XDRX API 晓东工具箱 
  • 发布时间 :2020-07-06
  • 命令名称 :xdtb_arc2pt
  • 插件介绍 :【工具】动态 两点绘制圆弧
  • 备  注 : (点击图片可以放大)
(点击图片可以放大)

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

插件详细内容

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

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

x
  1. (defun c:xdtb_arc2pt (/             _tmp   ali1   ali2          ar         arc        bl
  2.                       dir    distl  dynpt  e1          h         h1        lastpnt
  3.                       lxds   p1            p2           pmid          pmid1         tbox        tf
  4.                       txt1   txt2   txth   typeface         v        w
  5.                       xdir
  6.                      )
  7.   (defun xd::textstyle:temp (typeface / _tmp)
  8.     (setq _tmp (xdrx-object-clone (xdrx-object-get "style" "standard")))
  9.     (xdrx-setpropertyvalue _tmp "font" typeface)
  10.     (list (xdrx-getpropertyvalue _tmp "name") _tmp)
  11.   )
  12.   (defun _prompt ()
  13.     (xdrx-prompt
  14.       "\n当前设置:步长 "
  15.       (xdrx-getvar "distancesnap")
  16.     )
  17.   )
  18.   (defun _callback (dynpt)
  19.     (redraw)
  20.     (if        (not
  21.           (equal (xdrx-points-area (trans p1 1 0) dynpt (trans p2 1 0))
  22.                  0
  23.                  1e-4
  24.           )
  25.         )
  26.       (progn
  27.         (if (xdrx-setpropertyvalue arc "set" (list p1 dynpt p2))
  28.           (progn (setq bl (xdrx-getpropertyvalue arc "bulge"))
  29.                  (if (< (xdrx-points-area p1 dynpt p2) 0)
  30.                    (setq bl (- bl))
  31.                  )
  32.                  (setq ar (xdrx-points-area p1 dynpt p2)
  33.                        ar (/ ar (abs ar))
  34.                  )
  35.                  (setq pmid (xdrx-getpropertyvalue arc "midpoint")
  36.                        h    (xdrx-getpropertyvalue
  37.                               (list p1 p2)
  38.                               "getclosestpointto"
  39.                               pmid
  40.                             )
  41.                        h1   (* ar (/ (setq distl (distance pmid h)) w))
  42.                        xdir (xdrx-vector-normalize (mapcar '- pmid h))
  43.                  )
  44.                  (setq distl (xdrx-math-roundto
  45.                                distl
  46.                                (xdrx-getvar "distancesnap")
  47.                              )
  48.                        dynpt (mapcar '+
  49.                                      h
  50.                                      (xdrx-vector-product
  51.                                        (xdrx-vector-normalize (mapcar '- pmid h))
  52.                                        distl
  53.                                      )
  54.                              )
  55.                        pmid1 (xdrx-line-midp dynpt h)
  56.                  )
  57.                  (xdrx-setpropertyvalue arc "set" (list p1 dynpt p2))
  58.                  (setq bl (xdrx-getpropertyvalue arc "bulge"))
  59.                  (if (< (xdrx-points-area p1 dynpt p2) 0)
  60.                    (setq bl (- bl))
  61.                  )
  62.                  (xdrx-setpropertyvalue e1 "bulgeat" (list 0 bl))
  63.                  (xdrx-grdraw 42 -1 dynpt h)
  64.                  (setq txth (xd::doc:getpickboxheight))
  65.                  (xdrx-setpropertyvalue
  66.                    txt1
  67.                    "textstring"
  68.                    (rtos (abs distl) 2 1)
  69.                    "textheight"
  70.                    txth
  71.                    "textstyle"
  72.                    (cadr font)
  73.                  )
  74.                  (setq tbox (xdrx-getpropertyvalue txt1 "textbox")
  75.                        tbox (xd::pnts:close tbox)
  76.                        tbox (xdrx-points-offset txth tbox)
  77.                        ali1 (xd::geom:get9pt tbox 6)
  78.                        v    (if        (< bl 0)
  79.                               (xdrx-vector-normalize
  80.                                 (mapcar '- (caddr tbox) (cadr tbox))
  81.                               )
  82.                               (xdrx-vector-normalize
  83.                                 (mapcar '- (cadr tbox) (caddr tbox))
  84.                               )
  85.                             )
  86.                  )
  87.                  (xdrx-entity-align
  88.                    txt1
  89.                    ali1
  90.                    v
  91.                    (mapcar '+
  92.                            pmid1
  93.                            (xdrx-vector-product
  94.                              (xdrx-vector-perpvector xdir)
  95.                              (if (< bl 0)
  96.                                (/ txth 2.0)
  97.                                (- (/ txth 2.0))
  98.                              )
  99.                            )
  100.                    )
  101.                    xdir
  102.                  )
  103.                  (xd::text:adjust txt1)
  104.                  (xdrx-grdraw 42 -1 txt1)
  105.                  ;;
  106.                  (xdrx-setpropertyvalue
  107.                    txt2
  108.                    "textstring"
  109.                    (rtos h1 2 2)
  110.                    "textheight"
  111.                    txth
  112.                    "textstyle"
  113.                    (cadr font)
  114.                  )
  115.                  (setq tbox (xdrx-getpropertyvalue txt2 "textbox")
  116.                        tbox (xd::pnts:close tbox)
  117.                        tbox (xdrx-points-offset txth tbox)
  118.                        ali2 (xd::geom:get9pt tbox 4)
  119.                        v    (if        (< bl 0)
  120.                               (xdrx-vector-normalize
  121.                                 (mapcar '- (nth 3 tbox) (nth 0 tbox))
  122.                               )
  123.                               (xdrx-vector-normalize
  124.                                 (mapcar '- (nth 0 tbox) (nth 3 tbox))
  125.                               )
  126.                             )
  127.                  )
  128.                  (xdrx-entity-align
  129.                    txt2
  130.                    ali2
  131.                    v
  132.                    (mapcar
  133.                      '+
  134.                      pmid1
  135.                      (xdrx-vector-product
  136.                        (xdrx-vector-negate (xdrx-vector-perpvector xdir))
  137.                        (if (< bl 0)
  138.                          (/ txth 2.0)
  139.                          (- (/ txth 2.0))
  140.                        )
  141.                      )
  142.                    )
  143.                    xdir
  144.                  )
  145.                  (xd::text:adjust txt2)
  146.                  (xdrx-grdraw 42 -1 txt2)
  147.                  (setq lxds (cons dynpt (list (car lxds))))
  148.           )
  149.         )
  150.       )
  151.     )
  152.   )
  153.   (xdrx-begin)
  154.   (xdrx-sysvar-push '("osmode" 0 "dimzin" 0 "pickbox" 7))
  155.   (xdrx-initget "0 1")
  156.   (if (not #mode)
  157.     (setq #mode 0)
  158.   )
  159.   (if (setq v (getint (xdrx-prompt
  160.                         "\n类型:[普通圆弧(0)/多段线圆弧(1)]<"
  161.                         #mode
  162.                         ">:"
  163.                         t
  164.                       )
  165.               )
  166.       )
  167.     (setq #mode v)
  168.   )
  169.   (if (and (setq p1 (getpoint "\n圆弧第一点<退出>:"))
  170.            (setq p2 (getpoint p1 "\n圆弧终点<退出>:"))
  171.            (xdrx-polyline-make (trans p1 1 0) (trans p2 1 0))
  172.            (setq e1 (entlast))
  173.       )
  174.     (progn
  175.       (mapcar 'set
  176.               '(p1 p2)
  177.               (xdrx-getpropertyvalue e1 "startpoint" "endpoint")
  178.       )
  179.       (setq w (/ (distance p1 p2) 2.0))
  180.       (setq arc        (xdge::constructor "kcircarc3d")
  181.             dir        (xdrx-points-area e1)
  182.       )
  183.       (setq txt1 (xdrx-text-make)
  184.             txt2 (xdrx-text-make)
  185.       )
  186.       (xdrx-pointmonitor "_callback")
  187.       (setq tf t)
  188.       (setq lastpnt (getvar "lastpoint"))
  189.       (setq font (xd::textstyle:temp "consolas"))
  190.       (setq lxds nil)
  191.       (while (and tf
  192.                   (xdrx-initget "A S D F G")
  193.                   (_prompt)
  194.                   (setq        pmid1
  195.                          (getpoint
  196.                            "\n输入矢高[步长0(A)/步长1(D)/步长5(F)/步长10(G)/步长设置(S)]:"
  197.                          )
  198.                   )
  199.              )
  200.         (cond
  201.           ((= pmid1 "A") (xdrx-setvar "distancesnap" 0))
  202.           ((= pmid1 "D") (xdrx-setvar "distancesnap" 1))
  203.           ((= pmid1 "F") (xdrx-setvar "distancesnap" 5))
  204.           ((= pmid1 "G") (xdrx-setvar "distancesnap" 10))
  205.           ((= pmid1 "S")
  206.            (if (setq v (getreal        (xdrx-prompt
  207.                                   "\n输入步长<"
  208.                                   (xdrx-getvar "distancesnap")
  209.                                   ">:"
  210.                                   t
  211.                                 )
  212.                        )
  213.                )
  214.              (xdrx-setvar "distancesnap" v)
  215.            )
  216.           )
  217.           ((listp pmid1)
  218.            (if (= (xdrx-getvar "lastinput") 0)
  219.              (progn (setq
  220.                       bl (* (/ (xdrx-points-area p1 (cadr lxds) p2)
  221.                                (abs (xdrx-points-area p1 (cadr lxds) p2))
  222.                             )
  223.                             (distance pmid1 lastpnt)
  224.                          )
  225.                     )
  226.                     (xdrx-setpropertyvalue e1 "bulge" bl)
  227.              )
  228.            )
  229.            (setq tf nil)
  230.           )
  231.         )
  232.       )
  233.       (xdrx-pointmonitor)
  234.       (xdrx-object-delete (cadr font))
  235.       (redraw)
  236.       (if (= #mode 0)
  237.         (progn (xdrx-entity-explode t (entlast))
  238.                (xdrx-prompt
  239.                  "\n已经生圆弧"
  240.                  (rtos distl 2 1)
  241.                  ",矢高 "
  242.                  (rtos (abs bl) 2 2)
  243.                )
  244.         )
  245.         (xdrx-prompt
  246.           "\n已经生成多段线圆弧"
  247.           (rtos distl 2 1)
  248.           ",矢高"
  249.           (rtos (abs bl) 2 2)
  250.           ",时针方向:"
  251.           (if (minusp bl)
  252.             "顺时针."
  253.             "逆时针."
  254.           )
  255.         )
  256.       )
  257.     )
  258.   )
  259.   (xdrx-sysvar-pop)
  260.   (xdrx-end)
  261.   (princ)
  262. )


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

已领礼包: 5869个

财富等级: 富甲天下

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

使用道具 举报

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

使用道具 举报

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2021-9-21 07:12 , Processed in 0.698692 second(s), 37 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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