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

newer · 发表于 2020-7-6 14:15:31

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

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

×

(defun c:xdtb_arc2pt (/ _tmp ali1 ali2 ar arc bl
dir distl dynpt e1 h h1 lastpnt
lxds p1 p2 pmid pmid1 tbox tf
txt1 txt2 txth typeface v w
xdir
)
(defun xd::textstyle:temp (typeface / _tmp)
(setq _tmp (xdrx-object-clone (xdrx-object-get "style" "standard")))
(xdrx-setpropertyvalue _tmp "font" typeface)
(list (xdrx-getpropertyvalue _tmp "name") _tmp)
)
(defun _prompt ()
(xdrx-prompt
"\n当前设置：步长 "
(xdrx-getvar "distancesnap")
)
)
(defun _callback (dynpt)
(redraw)
(if (not
(equal (xdrx-points-area (trans p1 1 0) dynpt (trans p2 1 0))
0
1e-4
)
)
(progn
(if (xdrx-setpropertyvalue arc "set" (list p1 dynpt p2))
(progn (setq bl (xdrx-getpropertyvalue arc "bulge"))
(if (< (xdrx-points-area p1 dynpt p2) 0)
(setq bl (- bl))
)
(setq ar (xdrx-points-area p1 dynpt p2)
ar (/ ar (abs ar))
)
(setq pmid (xdrx-getpropertyvalue arc "midpoint")
h (xdrx-getpropertyvalue
(list p1 p2)
"getclosestpointto"
pmid
)
h1 (* ar (/ (setq distl (distance pmid h)) w))
xdir (xdrx-vector-normalize (mapcar '- pmid h))
)
(setq distl (xdrx-math-roundto
distl
(xdrx-getvar "distancesnap")
)
dynpt (mapcar '+
h
(xdrx-vector-product
(xdrx-vector-normalize (mapcar '- pmid h))
distl
)
)
pmid1 (xdrx-line-midp dynpt h)
)
(xdrx-setpropertyvalue arc "set" (list p1 dynpt p2))
(setq bl (xdrx-getpropertyvalue arc "bulge"))
(if (< (xdrx-points-area p1 dynpt p2) 0)
(setq bl (- bl))
)
(xdrx-setpropertyvalue e1 "bulgeat" (list 0 bl))
(xdrx-grdraw 42 -1 dynpt h)
(setq txth (xd::doc:getpickboxheight))
(xdrx-setpropertyvalue
txt1
"textstring"
(rtos (abs distl) 2 1)
"textheight"
txth
"textstyle"
(cadr font)
)
(setq tbox (xdrx-getpropertyvalue txt1 "textbox")
tbox (xd::pnts:close tbox)
tbox (xdrx-points-offset txth tbox)
ali1 (xd::geom:get9pt tbox 6)
v (if (< bl 0)
(xdrx-vector-normalize
(mapcar '- (caddr tbox) (cadr tbox))
)
(xdrx-vector-normalize
(mapcar '- (cadr tbox) (caddr tbox))
)
)
)
(xdrx-entity-align
txt1
ali1
v
(mapcar '+
pmid1
(xdrx-vector-product
(xdrx-vector-perpvector xdir)
(if (< bl 0)
(/ txth 2.0)
(- (/ txth 2.0))
)
)
)
xdir
)
(xd::text:adjust txt1)
(xdrx-grdraw 42 -1 txt1)
;;
(xdrx-setpropertyvalue
txt2
"textstring"
(rtos h1 2 2)
"textheight"
txth
"textstyle"
(cadr font)
)
(setq tbox (xdrx-getpropertyvalue txt2 "textbox")
tbox (xd::pnts:close tbox)
tbox (xdrx-points-offset txth tbox)
ali2 (xd::geom:get9pt tbox 4)
v (if (< bl 0)
(xdrx-vector-normalize
(mapcar '- (nth 3 tbox) (nth 0 tbox))
)
(xdrx-vector-normalize
(mapcar '- (nth 0 tbox) (nth 3 tbox))
)
)
)
(xdrx-entity-align
txt2
ali2
v
(mapcar
'+
pmid1
(xdrx-vector-product
(xdrx-vector-negate (xdrx-vector-perpvector xdir))
(if (< bl 0)
(/ txth 2.0)
(- (/ txth 2.0))
)
)
)
xdir
)
(xd::text:adjust txt2)
(xdrx-grdraw 42 -1 txt2)
(setq lxds (cons dynpt (list (car lxds))))
)
)
)
)
)
(xdrx-begin)
(xdrx-sysvar-push '("osmode" 0 "dimzin" 0 "pickbox" 7))
(xdrx-initget "0 1")
(if (not #mode)
(setq #mode 0)
)
(if (setq v (getint (xdrx-prompt
"\n类型:[普通圆弧(0)/多段线圆弧(1)]<"
#mode
">:"
t
)
)
)
(setq #mode v)
)
(if (and (setq p1 (getpoint "\n圆弧第一点<退出>:"))
(setq p2 (getpoint p1 "\n圆弧终点<退出>:"))
(xdrx-polyline-make (trans p1 1 0) (trans p2 1 0))
(setq e1 (entlast))
)
(progn
(mapcar 'set
'(p1 p2)
(xdrx-getpropertyvalue e1 "startpoint" "endpoint")
)
(setq w (/ (distance p1 p2) 2.0))
(setq arc (xdge::constructor "kcircarc3d")
dir (xdrx-points-area e1)
)
(setq txt1 (xdrx-text-make)
txt2 (xdrx-text-make)
)
(xdrx-pointmonitor "_callback")
(setq tf t)
(setq lastpnt (getvar "lastpoint"))
(setq font (xd::textstyle:temp "consolas"))
(setq lxds nil)
(while (and tf
(xdrx-initget "A S D F G")
(_prompt)
(setq pmid1
(getpoint
"\n输入矢高[步长0(A)/步长1(D)/步长5(F)/步长10(G)/步长设置(S)]:"
)
)
)
(cond
((= pmid1 "A") (xdrx-setvar "distancesnap" 0))
((= pmid1 "D") (xdrx-setvar "distancesnap" 1))
((= pmid1 "F") (xdrx-setvar "distancesnap" 5))
((= pmid1 "G") (xdrx-setvar "distancesnap" 10))
((= pmid1 "S")
(if (setq v (getreal (xdrx-prompt
"\n输入步长<"
(xdrx-getvar "distancesnap")
">:"
t
)
)
)
(xdrx-setvar "distancesnap" v)
)
)
((listp pmid1)
(if (= (xdrx-getvar "lastinput") 0)
(progn (setq
bl (* (/ (xdrx-points-area p1 (cadr lxds) p2)
(abs (xdrx-points-area p1 (cadr lxds) p2))
)
(distance pmid1 lastpnt)
)
)
(xdrx-setpropertyvalue e1 "bulge" bl)
)
)
(setq tf nil)
)
)
)
(xdrx-pointmonitor)
(xdrx-object-delete (cadr font))
(redraw)
(if (= #mode 0)
(progn (xdrx-entity-explode t (entlast))
(xdrx-prompt
"\n已经生圆弧"
(rtos distl 2 1)
",矢高 "
(rtos (abs bl) 2 2)
)
)
(xdrx-prompt
"\n已经生成多段线圆弧"
(rtos distl 2 1)
",矢高"
(rtos (abs bl) 2 2)
",时针方向:"
(if (minusp bl)
"顺时针."
"逆时针."
)
)
)
)
)
(xdrx-sysvar-pop)
(xdrx-end)
(princ)
)

(defun c:xdtb_arc2pt (/             _tmp   ali1   ali2          ar         arc        bl 
                      dir    distl  dynpt  e1          h         h1        lastpnt 
                      lxds   p1            p2           pmid          pmid1         tbox        tf 
                      txt1   txt2   txth   typeface         v        w 
                      xdir 
                     ) 
  (defun xd::textstyle:temp (typeface / _tmp) 
    (setq _tmp (xdrx-object-clone (xdrx-object-get "style" "standard"))) 
    (xdrx-setpropertyvalue _tmp "font" typeface) 
    (list (xdrx-getpropertyvalue _tmp "name") _tmp) 
  ) 
  (defun _prompt () 
    (xdrx-prompt 
      "\n当前设置：步长 " 
      (xdrx-getvar "distancesnap") 
    ) 
  ) 
  (defun _callback (dynpt) 
    (redraw) 
    (if        (not 
          (equal (xdrx-points-area (trans p1 1 0) dynpt (trans p2 1 0)) 
                 0 
                 1e-4 
          ) 
        ) 
      (progn 
        (if (xdrx-setpropertyvalue arc "set" (list p1 dynpt p2)) 
          (progn (setq bl (xdrx-getpropertyvalue arc "bulge")) 
                 (if (< (xdrx-points-area p1 dynpt p2) 0) 
                   (setq bl (- bl)) 
                 ) 
                 (setq ar (xdrx-points-area p1 dynpt p2) 
                       ar (/ ar (abs ar)) 
                 ) 
                 (setq pmid (xdrx-getpropertyvalue arc "midpoint") 
                       h    (xdrx-getpropertyvalue 
                              (list p1 p2) 
                              "getclosestpointto" 
                              pmid 
                            ) 
                       h1   (* ar (/ (setq distl (distance pmid h)) w)) 
                       xdir (xdrx-vector-normalize (mapcar '- pmid h)) 
                 ) 
                 (setq distl (xdrx-math-roundto 
                               distl 
                               (xdrx-getvar "distancesnap") 
                             ) 
                       dynpt (mapcar '+ 
                                     h 
                                     (xdrx-vector-product 
                                       (xdrx-vector-normalize (mapcar '- pmid h)) 
                                       distl 
                                     ) 
                             ) 
                       pmid1 (xdrx-line-midp dynpt h) 
                 ) 
                 (xdrx-setpropertyvalue arc "set" (list p1 dynpt p2)) 
                 (setq bl (xdrx-getpropertyvalue arc "bulge")) 
                 (if (< (xdrx-points-area p1 dynpt p2) 0) 
                   (setq bl (- bl)) 
                 ) 
                 (xdrx-setpropertyvalue e1 "bulgeat" (list 0 bl)) 
                 (xdrx-grdraw 42 -1 dynpt h) 
                 (setq txth (xd::doc:getpickboxheight)) 
                 (xdrx-setpropertyvalue 
                   txt1 
                   "textstring" 
                   (rtos (abs distl) 2 1) 
                   "textheight" 
                   txth 
                   "textstyle" 
                   (cadr font) 
                 ) 
                 (setq tbox (xdrx-getpropertyvalue txt1 "textbox") 
                       tbox (xd::pnts:close tbox) 
                       tbox (xdrx-points-offset txth tbox) 
                       ali1 (xd::geom:get9pt tbox 6) 
                       v    (if        (< bl 0) 
                              (xdrx-vector-normalize 
                                (mapcar '- (caddr tbox) (cadr tbox)) 
                              ) 
                              (xdrx-vector-normalize 
                                (mapcar '- (cadr tbox) (caddr tbox)) 
                              ) 
                            ) 
                 ) 
                 (xdrx-entity-align 
                   txt1 
                   ali1 
                   v 
                   (mapcar '+ 
                           pmid1 
                           (xdrx-vector-product 
                             (xdrx-vector-perpvector xdir) 
                             (if (< bl 0) 
                               (/ txth 2.0) 
                               (- (/ txth 2.0)) 
                             ) 
                           ) 
                   ) 
                   xdir 
                 ) 
                 (xd::text:adjust txt1) 
                 (xdrx-grdraw 42 -1 txt1) 
                 ;; 
                 (xdrx-setpropertyvalue 
                   txt2 
                   "textstring" 
                   (rtos h1 2 2) 
                   "textheight" 
                   txth 
                   "textstyle" 
                   (cadr font) 
                 ) 
                 (setq tbox (xdrx-getpropertyvalue txt2 "textbox") 
                       tbox (xd::pnts:close tbox) 
                       tbox (xdrx-points-offset txth tbox) 
                       ali2 (xd::geom:get9pt tbox 4) 
                       v    (if        (< bl 0) 
                              (xdrx-vector-normalize 
                                (mapcar '- (nth 3 tbox) (nth 0 tbox)) 
                              ) 
                              (xdrx-vector-normalize 
                                (mapcar '- (nth 0 tbox) (nth 3 tbox)) 
                              ) 
                            ) 
                 ) 
                 (xdrx-entity-align 
                   txt2 
                   ali2 
                   v 
                   (mapcar 
                     '+ 
                     pmid1 
                     (xdrx-vector-product 
                       (xdrx-vector-negate (xdrx-vector-perpvector xdir)) 
                       (if (< bl 0) 
                         (/ txth 2.0) 
                         (- (/ txth 2.0)) 
                       ) 
                     ) 
                   ) 
                   xdir 
                 ) 
                 (xd::text:adjust txt2) 
                 (xdrx-grdraw 42 -1 txt2) 
                 (setq lxds (cons dynpt (list (car lxds)))) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (xdrx-begin) 
  (xdrx-sysvar-push '("osmode" 0 "dimzin" 0 "pickbox" 7)) 
  (xdrx-initget "0 1") 
  (if (not #mode) 
    (setq #mode 0) 
  ) 
  (if (setq v (getint (xdrx-prompt 
                        "\n类型:[普通圆弧(0)/多段线圆弧(1)]<" 
                        #mode 
                        ">:" 
                        t 
                      ) 
              ) 
      ) 
    (setq #mode v) 
  ) 
  (if (and (setq p1 (getpoint "\n圆弧第一点<退出>:")) 
           (setq p2 (getpoint p1 "\n圆弧终点<退出>:")) 
           (xdrx-polyline-make (trans p1 1 0) (trans p2 1 0)) 
           (setq e1 (entlast)) 
      ) 
    (progn 
      (mapcar 'set 
              '(p1 p2) 
              (xdrx-getpropertyvalue e1 "startpoint" "endpoint") 
      ) 
      (setq w (/ (distance p1 p2) 2.0)) 
      (setq arc        (xdge::constructor "kcircarc3d") 
            dir        (xdrx-points-area e1) 
      ) 
      (setq txt1 (xdrx-text-make) 
            txt2 (xdrx-text-make) 
      ) 
      (xdrx-pointmonitor "_callback") 
      (setq tf t) 
      (setq lastpnt (getvar "lastpoint")) 
      (setq font (xd::textstyle:temp "consolas")) 
      (setq lxds nil) 
      (while (and tf 
                  (xdrx-initget "A S D F G") 
                  (_prompt) 
                  (setq        pmid1 
                         (getpoint 
                           "\n输入矢高[步长0(A)/步长1(D)/步长5(F)/步长10(G)/步长设置(S)]:" 
                         ) 
                  ) 
             ) 
        (cond 
          ((= pmid1 "A") (xdrx-setvar "distancesnap" 0)) 
          ((= pmid1 "D") (xdrx-setvar "distancesnap" 1)) 
          ((= pmid1 "F") (xdrx-setvar "distancesnap" 5)) 
          ((= pmid1 "G") (xdrx-setvar "distancesnap" 10)) 
          ((= pmid1 "S") 
           (if (setq v (getreal        (xdrx-prompt 
                                  "\n输入步长<" 
                                  (xdrx-getvar "distancesnap") 
                                  ">:" 
                                  t 
                                ) 
                       ) 
               ) 
             (xdrx-setvar "distancesnap" v) 
           ) 
          ) 
          ((listp pmid1) 
           (if (= (xdrx-getvar "lastinput") 0) 
             (progn (setq 
                      bl (* (/ (xdrx-points-area p1 (cadr lxds) p2) 
                               (abs (xdrx-points-area p1 (cadr lxds) p2)) 
                            ) 
                            (distance pmid1 lastpnt) 
                         ) 
                    ) 
                    (xdrx-setpropertyvalue e1 "bulge" bl) 
             ) 
           ) 
           (setq tf nil) 
          ) 
        ) 
      ) 
      (xdrx-pointmonitor) 
      (xdrx-object-delete (cadr font)) 
      (redraw) 
      (if (= #mode 0) 
        (progn (xdrx-entity-explode t (entlast)) 
               (xdrx-prompt 
                 "\n已经生圆弧" 
                 (rtos distl 2 1) 
                 ",矢高 " 
                 (rtos (abs bl) 2 2) 
               ) 
        ) 
        (xdrx-prompt 
          "\n已经生成多段线圆弧" 
          (rtos distl 2 1) 
          ",矢高" 
          (rtos (abs bl) 2 2) 
          ",时针方向:" 
          (if (minusp bl) 
            "顺时针." 
            "逆时针." 
          ) 
        ) 
      ) 
    ) 
  ) 
  (xdrx-sysvar-pop) 
  (xdrx-end) 
  (princ) 
)

Michael527 · 发表于 2020-7-6 19:23:08

这个工具挺实用，谢谢分享

z511367698 · 发表于 2021-1-13 16:46:37

用，谢谢分享

showmyself · 发表于 2021-1-14 09:13:24

貌似还可以，下载下来学习下

账号		自动登录	找回密码
密码			立即注册

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

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

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