New arc dimension program

November 14, 2011

Found two routines that do arc dimension:

First - need to select arc,

Second - need two points on arc, circle.

It is possible to combine both of them to do: select arc or select two points on it and get arc dimension as per "dimarc.lsp"

First routine:

;DIMMARC.LSP - Dimension an arc with length, rather than angle
;(c) 1998 Tee Square Graphics

(defun C:DIMARC (/ arc ent obj l)
 (setq cmd (getvar "cmdecho")
       arc (entsel "\nPick ARC to dimension: ")
       ent (entget (car arc))
       obj (cdr (assoc 0 ent)))
 (if (= obj "ARC")
   (progn
     (setvar "cmdecho" 1)
     (setq l (* (cdr (assoc 40 ent))
                (if (minusp (setq l (- (cdr (assoc 51 ent))
                                       (cdr (assoc 50 ent)))))
                  (+ pi pi l) l)))
     (command "_.dimangular" arc "_t" (rtos l))
     (while (= (logand (getvar "cmdactive") 1) 1)
       (command pause))
     (setvar "cmdecho" cmd))
   (alert "Object selected is not an ARC."))
 (princ)
)

and second:

;;; YZ Enterprise
;;;ARCDIST.LSP
;;; LISP routine for finding arc lenght 
;;; 
;;; by Allan Wise   12-Nov-1997
;;;
(princ "\nFind the arc length ")
(princ "\nType Arcdist to begin...... ")
(defun c:arcdist ( )
     (setq chord (getdist "\nPick two points on arc:  "))
     (setq et (nentsel "\nSelect arc:  "))
     (setq radius (cdr (assoc 40(entget (car et)))))
     (setq x1 (* 2 pi radius))
     (setq hc (* 0.5 chord))
     (setq x2 (- (* radius radius)(* hc hc)))
     (setq x3 (expt x2 0.5))
     (setq theta (/ hc x3))
     (setq ang (atan theta))
     (setq a1 ( * 2 ang))
     (setq a2 (rtd a1))
     (setq a3 (/ a2 360))
     (setq ans (* a3 x1))
     (prompt "\nArc length is ")
     (princ ans)
     (princ) 
(command "_.dimangular" arc "_t" (rtos l))
) 

(defun rtd (a)
    (* 180 ( / a pi))
)

Thank you.

November 14, 2011

Since you are using ACAD2010, why not use the DIMARC command?

November 14, 2011

Arcdist routine allowed for selecting two point on arc or circle, dimarc don't have this option. Now we have trend to combine everything...

Why not expand it, make more useful (IMO).

November 14, 2011

mdbdesign said:
Arcdist routine allowed for selecting two point on arc or circle, dimarc don't have this option. Now we have trend to combine everything...
Why not expand it, make more useful (IMO).

I just couldn't see why you wanted to create an Angular Dimension to display the Arc Length.

November 14, 2011

I think, because of shape of angular dimension is visually correct to describe measured object (arc) but instead of degree print length. Make sens for me.

November 14, 2011

For fun...

(defun c:ArcDim (/ *error* AT:CycleThroughSS p1 ent p2 ss d1 d2)
 ;; label Arc with Dimension between two picked points
 ;; Alan J. Thompson, 11.14.11

 (vl-load-com)

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

 (defun AT:CycleThroughSS (ss / l i e)
   ;; Cycle through a selection set to choose one
   ;; ss - selection set
   ;; Alan J. Thompson, 03.30.11
   (if (eq (type ss) 'PICKSET)
     (if (eq (setq l (sslength ss)) 1)
       (ssname ss 0)
       (progn (princ "\n<Tab> to cycle through entities: ")
              (redraw (setq e (ssname ss (setq i 0))) 3)
              (while (eq (cadr (grread nil 10)) 9)
                (mapcar 'redraw (list e (setq e (ssname ss (setq i (rem (1+ i) l))))) '(4 3))
              )
              (redraw e 4)
              e
       )
     )
   )
 )


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

 (cond ((not vla-addDimArc) (alert "AutoCAD version not supported!"))
       ((not (setq p1 (getpoint "\nSpecify fist point on arc: "))))
       ((not (setq ent (AT:CycleThroughSS (ssget "_C" p1 p1 '((0 . "ARC"))))))
        (alert "Point must be on arc!")
       )
       ((redraw ent 3))
       ((not (setq p2 (getpoint p1 "\nSpecify other point on arc: "))))
       ((not (and (setq ss (ssget "_C" p2 p2 '((0 . "ARC"))))
                  (vl-some '(lambda (e) (equal ent (cadr e))) (ssnamex ss))
             )
        )
        (alert "Point must be on arc!")
       )
       ((vlax-invoke
          (vlax-get *AcadDoc*
                    (if (eq (getvar 'CVPORT) 1)
                      'Paperspace
                      'Modelspace
                    )
          )
          'addDimArc
          (cdr (assoc 10 (entget ent)))
          (trans p1 1 0)
          (trans p2 1 0)
          (vlax-curve-getPointAtDist
            ent
            (+ (min (setq d1 (vlax-curve-getDistAtPoint ent (trans p1 1 ent)))
                    (setq d2 (vlax-curve-getDistAtPoint ent (trans p2 1 ent)))
               )
               (/ (abs (- d1 d2)) 2.)
            )
          )
        )
       )
 )

 (*error* nil)
 (princ)
)

I know Lee will fuss at me for using the vlax-curve* function to find the midpoint, but I couldn't remember the math and I have a habit of being lazy.

November 14, 2011

alanjt said:
I know Lee will fuss at me for using the vlax-curve* function to find the midpoint

You can do as you please, I shan't fuss at anyone

November 14, 2011

Lee Mac said:
You can do as you please, I shan't fuss at anyone

Fine fine, I'll just ask. How do you find it mathematically?

November 14, 2011

mdbdesign said:
I think, because of shape of angular dimension is visually correct to describe measured object (arc) but instead of degree print length. Make sens for me.

But you would lose associativity should the arc be modified since the text is an override...

FYI you can select two points using the DIMARC command:

Command: _dimarc
Select arc or polyline arc segment:
Specify arc length dimension location, or [Mtext/Text/Angle/[color=red]Partial[/color]]:

November 14, 2011

Lee Mac said:
FYI you can select two points using the DIMARC command:
Command: _dimarc
Select arc or polyline arc segment:
Specify arc length dimension location, or [Mtext/Text/Angle/[color=red]Partial[/color]]:

Well I'll be damned. Forget my code.

Thinking about it, the functionality makes sense, since it's different than other Dim* commands.

I think I still prefer the following functionality, but it's not really much reason for a macro...then again, I have one to draw an arc at end/end/radius and I use it daily.

(defun c:ArcDim (/ *error* AT:CycleThroughSS cmd p1 ent p2 ss d1 d2)
 ;; label Arc with Dimension between two picked points
 ;; Alan J. Thompson, 11.14.11

 (vl-load-com)

 (defun *error* (msg)
   (and ent (redraw ent 4))
   (and cmd (setvar 'CMDECHO cmd))
   (and *AcadDoc* (vla-endundomark *AcadDoc*))
   (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat "\nError: " msg))
   )
 )

 (defun AT:CycleThroughSS (ss / l i e)
   ;; Cycle through a selection set to choose one
   ;; ss - selection set
   ;; Alan J. Thompson, 03.30.11
   (if (eq (type ss) 'PICKSET)
     (if (eq (setq l (sslength ss)) 1)
       (ssname ss 0)
       (progn (princ "\n<Tab> to cycle through entities: ")
              (redraw (setq e (ssname ss (setq i 0))) 3)
              (while (eq (cadr (grread nil 10)) 9)
                (mapcar 'redraw (list e (setq e (ssname ss (setq i (rem (1+ i) l))))) '(4 3))
              )
              (redraw e 4)
              e
       )
     )
   )
 )


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

 (setq cmd (getvar 'CMDECHO))
 (setvar 'CMDECHO 0)

 (cond ((not vla-addDimArc) (alert "AutoCAD version not supported!"))
       ((not (setq p1 (getpoint "\nSpecify fist point on arc: "))))
       ((not (setq ent (AT:CycleThroughSS (ssget "_C" p1 p1 '((0 . "ARC"))))))
        (alert "Point must be on arc!")
       )
       ((redraw ent 3))
       ((not (setq p2 (getpoint p1 "\nSpecify other point on arc: "))))
       ((not (and (setq ss (ssget "_C" p2 p2 '((0 . "ARC"))))
                  (vl-some '(lambda (e) (equal ent (cadr e))) (ssnamex ss))
             )
        )
        (alert "Point must be on arc!")
       )
       ((vl-cmdf "_.dimarc" (list ent p1) "_partial" "_non" p1 "_non" p2 PAUSE))
;;;        ((vlax-invoke
;;;           (vlax-get *AcadDoc*
;;;                     (if (eq (getvar 'CVPORT) 1)
;;;                       'Paperspace
;;;                       'Modelspace
;;;                     )
;;;           )
;;;           'addDimArc
;;;           (cdr (assoc 10 (entget ent)))
;;;           (trans p1 1 0)
;;;           (trans p2 1 0)
;;;           (vlax-curve-getPointAtDist
;;;             ent
;;;             (+ (min (setq d1 (vlax-curve-getDistAtPoint ent (trans p1 1 ent)))
;;;                     (setq d2 (vlax-curve-getDistAtPoint ent (trans p2 1 ent)))
;;;                )
;;;                (/ (abs (- d1 d2)) 2.)
;;;             )
;;;           )
;;;         )
;;;        )
 )

 (*error* nil)
 (princ)
)

arcs & circles (no command)...

(defun c:ArcDim (/ *error* AT:CycleThroughSS cmd p1 ent p2 ss d1 d2)
 ;; label Arc with Dimension between two picked points
 ;; Alan J. Thompson, 11.14.11

 (vl-load-com)

 (defun *error* (msg)
   (and ent (redraw ent 4))
;;;    (and cmd (setvar 'CMDECHO cmd))
   (and *AcadDoc* (vla-endundomark *AcadDoc*))
   (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat "\nError: " msg))
   )
 )

 (defun AT:CycleThroughSS (ss / l i e)
   ;; Cycle through a selection set to choose one
   ;; ss - selection set
   ;; Alan J. Thompson, 03.30.11
   (if (eq (type ss) 'PICKSET)
     (if (eq (setq l (sslength ss)) 1)
       (ssname ss 0)
       (progn (princ "\n<Tab> to cycle through entities: ")
              (redraw (setq e (ssname ss (setq i 0))) 3)
              (while (eq (cadr (grread nil 10)) 9)
                (mapcar 'redraw (list e (setq e (ssname ss (setq i (rem (1+ i) l))))) '(4 3))
              )
              (redraw e 4)
              e
       )
     )
   )
 )


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

;;;  (setq cmd (getvar 'CMDECHO))
;;;  (setvar 'CMDECHO 0)

 (cond ((not vla-addDimArc) (alert "AutoCAD version not supported!"))
       ((not (setq p1 (getpoint "\nSpecify fist point on arc: "))))
       ((not (setq ent (AT:CycleThroughSS (ssget "_C" p1 p1 '((0 . "ARC,CIRCLE"))))))
        (alert "Point must be on arc!")
       )
       ((redraw ent 3))
       ((not (setq p2 (getpoint p1 "\nSpecify other point on arc: "))))
       ((not (and (setq ss (ssget "_C" p2 p2 '((0 . "ARC,CIRCLE"))))
                  (vl-some '(lambda (e) (equal ent (cadr e))) (ssnamex ss))
             )
        )
        (alert "Point must be on arc!")
       )
;;;        ((vl-cmdf "_.dimarc" (list ent p1) "_partial" "_non" p1 "_non" p2 PAUSE))
       ((vlax-invoke
          (vlax-get *AcadDoc*
                    (if (eq (getvar 'CVPORT) 1)
                      'Paperspace
                      'Modelspace
                    )
          )
          'addDimArc
          (cdr (assoc 10 (entget ent)))
          (trans p1 1 0)
          (trans p2 1 0)
          (vlax-curve-getClosestPointTo
            ent
            (mapcar '(lambda (a b) (/ (+ a b) 2.)) (trans p1 1 ent) (trans p2 1 ent))
          )
;;;           (vlax-curve-getPointAtDist
;;;             ent
;;;             (+ (min (setq d1 (vlax-curve-getDistAtPoint ent (trans p1 1 ent)))
;;;                     (setq d2 (vlax-curve-getDistAtPoint ent (trans p2 1 ent)))
;;;                )
;;;                (/ (abs (- d1 d2)) 2.)
;;;             )
;;;           )
        )
       )
 )

 (*error* nil)
 (princ)
)

Edited November 14, 2011 by alanjt

November 14, 2011

You right Lee, but I start playing with this:

try to find length of small portion of circle separated by line and selecting two points work OK. To get dimarc to work I need arc not a circle. That why I try to combine above two routines.

November 14, 2011

alanjt said:
Fine fine, I'll just ask. How do you find it mathematically?

Here's a (very hacked together) method:

(defun c:arcdim ( / a b cn el en p1 p2 rd )
   (while
       (progn (setq p1 (getpoint "\nSpecify First Point on Arc or Circle: "))
           (cond
               (   (null p1) (setq en nil))
               (   (null (setq en (nentselp p1)))
                   (princ "\nMissed, try again.")
               )
               (   (or (null (member (cdr (assoc 0 (entget (car en)))) '("ARC" "CIRCLE")))
                       (< 2 (length en))
                   )
                   (princ "\nPoint does not lie on an Arc or Circle.")
               )
           )
       )
   )
   (if
       (and
           (setq en (car en))
           (setq p1 (vlax-curve-getclosestpointto en (trans p1 1 0)))
           (setq p2 (getpoint (trans p1 0 1) "\nSpecify Second Point for Dimension: "))
           (setq p2 (vlax-curve-getclosestpointto en (trans p2 1 0)))
       )
       (progn
           (setq el (entget en)
                 cn (trans (cdr (assoc 10 el)) en 0)
                 rd (cdr (assoc 40 el))
           )
           (vla-put-textoverride
               (vlax-invoke
                   (vlax-get-property
                       (vla-get-activedocument (vlax-get-acad-object))
                       (if (= 1 (getvar 'CVPORT))
                           'paperspace
                           'modelspace
                       )
                   )
                   'adddimangular cn p1 p2
                   (mapcar '+ cn
                       (vxs 
                           (cond
                               (   (unit cn (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)))
                               (   (v^v (unit p1 p2) (cdr (assoc 210 el))))
                           )
                           (* 1.1 rd)
                       )
                   )
               )
               (rtos (* rd 2.0 (asin (/ (distance p1 p2) (* 2.0 rd)))))
           )
       )
   )
   (princ)
)

;; Unit - Lee Mac
;; Returns a unit vector from a to b
   
(defun unit ( a b )
   (   (lambda ( v )
           (   (lambda ( d )
                   (if (not (equal 0.0 d 1e-) (mapcar '/ v (list d d d)))
               )
               (distance '(0. 0. 0.) v)
           )
       )
       (mapcar '- b a)
   )
)

;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
   (mapcar '(lambda ( n ) (* n s)) v)
)

;; Vector Cross Product - Lee Mac
;; Args: u,v - vectors in R^3

(defun v^v ( u v )
   (list
       (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
       (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
       (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
   )
)

;; ArcSine - Lee Mac
;; Args: -1 <= x <= 1

(defun asin ( x )
   (cond
       (   (equal (abs x) 1.0 1e-
           (* x pi 0.5)
       )
       (   (< -1.0 x 1.0)
           (atan x (sqrt (- 1.0 (* x x))))
       )
   )
)

Edited November 14, 2011 by Lee Mac
fixed loop bug

November 14, 2011

Lee Mac said:
Here's a (very hacked together) method:

My first post should be: Lee can you hack it together?

Still learn...

Working OK except one when I select first point on arc or circle-always miss. Talk to my boss:

-It is hard to pick it on 19" monitor.

He said:

-Ok will see...

Thank you guys for help.

November 15, 2011

Here is my solution with one extra click that gives you the choice of either arc of the sectioned circle.

(defun c:arl (/ a b c d e r f g cp k n m osn)
 (command "ucs" "")
 (setq	osn (getvar "osmode")
a   (getpoint "\n First arc endpoint: ")
c   (getpoint "\n Second arc endpoint: "))
 (setvar "osmode" 512)
 (setq b (getpoint "\n Point on arc to measure: "))
 (setvar "osmode" 0)
 
 (command "arc" a b c)
 (setq	e  (entlast)
d  (entget e)
r  (cdr (assoc 40 d))
f  (cdr (assoc 50 d))
g  (cdr (assoc 51 d))
cp (cdr (assoc 10 d)))
 (entdel e)
 (if (> g f)
   (setq k (- g f))			
   (setq k (- (* 2.0 pi) (- f g)))	
 )
 (setq n (rtos (abs (* k r)))
       m (getpoint b "\n Arc length dimension location: "))
 (command "dim1" "angular" "" cp a c m n m)
 (setvar "osmode" osn)
 (command "ucs" "p")
 (princ)
)

Edited November 16, 2011 by paulmcz
UCS vomit

November 15, 2011

That it Paul. Thank you.

Sign In

New arc dimension program

Recommended Posts

mdbdesign

Lee Mac

mdbdesign

Lee Mac

mdbdesign

alanjt

Lee Mac

alanjt

Lee Mac

alanjt

mdbdesign

Lee Mac

mdbdesign

paulmcz

mdbdesign

Join the conversation

Tutorials

Forums

Activity