[编程交流] 圆弧半径

(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)
)

(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)
)

(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)
)

(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)
)

(defun c:TesT (/ ss i sn vl spc acdoc p c l rad p1)
 (vl-load-com)
 ;; Tharwat 23. Nov. 2011 ;;
 (if (setq  acdoc (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)
)