圆弧半径乐筑天下 - Powered by Discuz! Archiver

woohhoo 发表于 2022-7-6 08:37:52

圆弧半径

大家好，

有人知道是否已经有了一个代码，可以通过单击来获得圆弧起点和终点的半径。文字也应放在弧内（见（更新）图片）。

如果没有，有人能帮我吗？我在编程lisp方面很差，我非常需要它。

谢谢

Tharwat 发表于 2022-7-6 08:41:37

半径的角度是否始终为90.0度？

Tharwat 发表于 2022-7-6 08:47:20

试试这个。。。。

(defun c:TesT (/ rad p spc acdoc dim1 dim2)
(vl-load-com)
;; Tharwat 22. Nov. 2011 ;;
(if (and (setq rad (getdist "\n Specify Arc radius :"))
      (setq p (getpoint "\n Specify Center point for arc :"))
)
(progn
(setq spc (if (> (vla-get-activespace
                     (setq acdoc (vla-get-activedocument
                                 (vlax-get-acad-object)
                                 )
                     )
                  )
                  0
               )
            (vla-get-modelspace acdoc)
            (vla-get-paperspace acdoc)
            )
)
(vla-StartUndoMark acdoc)
(vla-addarc spc (vlax-3d-point p) rad 1.11022e-016 1.5708)
(setq dim1 (vla-adddimradial
               spc
               (vlax-3d-point p)
               (vlax-3d-point (polar p 0. rad))
               0.
            )
)
(vla-put-textposition
   dim1
   (vlax-3d-point (polar p 0. (- rad (/ rad 10.))))
)
(setq dim2 (vla-adddimradial
               spc
               (vlax-3d-point p)
               (vlax-3d-point (polar p (/ pi 2.) rad))
               10.
            )
)
(vla-put-textposition
   dim2
   (vlax-3d-point (polar p (/ pi 2.) (- rad (/ rad 10.))))
)
(vla-put-rotation dim2 (* pi 1.5))
(vla-EndUndoMark acdoc)
)
(princ)
)
(princ)
)

alanjt 发表于 2022-7-6 08:50:29

??

(defun c:Test (/ *error* i ss e d o)

(vl-load-com)

(defun *error* (msg)
(and *AcadDoc* (vla-endundomark *AcadDoc*))
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
(princ (strcat "\nError: " msg))
)
)

(vla-startundomark
(cond (*AcadDoc*)
      ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)

(if (setq i-1
      ss (ssget '((0 . "ARC")))
)
(while (setq e (ssname ss (setq i (1+ i))))
(setq d (entget e)
      o (vla-objectidtoobject *AcadDoc* (vla-get-ownerid (vlax-ename->vla-object e)))
)

(foreach point (list (polar (cdr (assoc 10 d)) (cdr (assoc 50 d)) (cdr (assoc 40 d)))
                     (polar (cdr (assoc 10 d)) (cdr (assoc 51 d)) (cdr (assoc 40 d)))
               )
   (vlax-invoke o 'adddimradial (cdr (assoc 10 d)) point -1.)
)
)
)
(*error* nil)
(princ)
)

woohhoo 发表于 2022-7-6 08:52:50

嗨，伙计们

Tharwat，谢谢你的输入，但我测试了你的代码，它运行良好，但有点复杂。
Alanjt编程的代码几乎正是我需要的，只有一个小问题。文字是否总是可以放置在弧内？如果您看到图片，autocad有时（我认为这取决于圆弧的放置方式）会将文本（在红色圆圈内）放在箭头的错误一侧。

无论如何，thx al lot用于输入！

Grz公司

Tharwat 发表于 2022-7-6 08:55:29

这是修改后的。。。。。

(defun c:TesT (/ ss i sn vl spc acdoc p c l rad p1)
(vl-load-com)
;; Tharwat 23. Nov. 2011 ;;
(if (setq ss (ssget '((0 . "ARC"))))
(repeat (setq i (sslength ss))
(setq sn (ssname ss (setq i (1- i))))
(setq vl (vlax-ename->vla-object sn))
(setq spc (if (> (vla-get-activespace
                     (setq acdoc (vla-get-activedocument
                                 (vlax-get-acad-object)
                                 )
                     )
                  )
                  0
               )
            (vla-get-modelspace acdoc)
            (vla-get-paperspace acdoc)
            )
)
(vla-StartUndoMark acdoC)
(vla-adddimradial
   spc
   (vlax-3d-point (setq p (vlax-get vl 'Startpoint)))
   (vlax-3d-point
      (polar p
            (angle p (setq c (vlax-get vl 'Center)))
            (setq l (/ (setq rad (vla-get-radius vl)) 5.))
      )
   )
   0.
)
(vla-adddimradial
   spc
   (vlax-3d-point (setq p1 (vlax-get vl 'Endpoint)))
   (vlax-3d-point (polar p1 (angle p1 c) l))
   0.
)
(vla-EndUndoMark acdoc)
)
(princ)
)
(princ)
)

alanjt 发表于 2022-7-6 08:59:23

在上图中，每个维度都在其对应的弧内。

alanjt 发表于 2022-7-6 09:02:42

您可能需要查看vla startundomark和vla endundomark的位置。您正在为selectionset中的每个ename执行这两个命令。

alanjt 发表于 2022-7-6 09:04:55

我会重新发布，以减轻我的一些疏忽。。。

(defun c:Test (/ *error* i ss e d o p r)

(vl-load-com)

(defun *error* (msg)
(and *AcadDoc* (vla-endundomark *AcadDoc*))
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
(princ (strcat "\nError: " msg))
)
)

(vla-startundomark
(cond (*AcadDoc*)
      ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)

(if (setq i-1
      ss (ssget '((0 . "ARC")))
)
(while (setq e (ssname ss (setq i (1+ i))))
(setq d (entget e)
      o (vla-objectidtoobject *AcadDoc* (vla-get-ownerid (vlax-ename->vla-object e)))
      p (cdr (assoc 10 d))
      r (cdr (assoc 40 d))
)
(foreach point (list (polar p (cdr (assoc 50 d)) r) (polar p (cdr (assoc 51 d)) r))
   (vlax-invoke o 'adddimradial p point -1.)
)
)
)
(*error* nil)
(princ)
)

Tharwat 发表于 2022-7-6 09:07:11

是啊如果用户想在操作之前返回，它会一个接一个地后退。

谢谢你的提示。

因此，这里是另一个修改的完全撤消标记到所有。

(defun c:TesT (/ ss i sn vl spc acdoc p c l rad p1)
(vl-load-com)
;; Tharwat 23. Nov. 2011 ;;
(if (setqacdoc (vla-get-activedocument
                     (vlax-get-acad-object)
                  )
         ss
      (ssget '((0 . "ARC")))
)
(progn
(vla-StartUndoMark acdoc)
(repeat (setq i (sslength ss))
   (setq sn (ssname ss (setq i (1- i))))
   (setq vl (vlax-ename->vla-object sn))
   (setq spc (if (> (vla-get-activespace
                     acdoc
                     )
                     0
                  )
               (vla-get-modelspace acdoc)
               (vla-get-paperspace acdoc)
            )
   )

   (vla-adddimradial
      spc
      (vlax-3d-point (setq p (vlax-get vl 'Startpoint)))
      (vlax-3d-point
      (polar p
               (angle p (setq c (vlax-get vl 'Center)))
               (setq l (/ (setq rad (vla-get-radius vl)) 5.))
      )
      )
      0.
   )
   (vla-adddimradial
      spc
      (vlax-3d-point (setq p1 (vlax-get vl 'Endpoint)))
      (vlax-3d-point (polar p1 (angle p1 c) l))
      0.
   )
)
(vla-EndUndoMark acdoc)
)
(princ)
)
(princ)
)

页: [1] 2

乐筑天下's Archiver

圆弧半径