Jump to content

Dimension along a curvy polyline


bigmaz

Recommended Posts

Hi

 

Is there and routines that would put a dimension along a curvy line? I dont need the actual dimension on, just the lines following the curve with the arrows and the perp lines coming out at each end. Its just to show extents along a curved road, and then a note next to it. I can do this manually by offsetting the line, and manually put the arrows and lines in at each end, but that is so time consuming when you have a lot of these to do.

 

Thanks

Martin

 

Wave.jpg

Link to comment
Share on other sites

Had a few minutes and was feeling generous:

 

[color=GREEN];; Dimension Curve  -  Lee Mac 2012[/color]
([color=BLUE]defun[/color] c:dimcurve ( [color=BLUE]/[/color] _line _arrow a b cm el en pt )

   ([color=BLUE]defun[/color] _line ( a b )
       ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 a) ([color=BLUE]cons[/color] 11 b)))
   )
   
   ([color=BLUE]defun[/color] _arrow ( a b )
       ([color=BLUE]entmake[/color]
           ([color=BLUE]list[/color]
              '(0 . [color=MAROON]"LWPOLYLINE"[/color])
              '(100 . [color=MAROON]"AcDbEntity"[/color])
              '(100 . [color=MAROON]"AcDbPolyline"[/color])
              '(90 . 2)
              '(70 . 0)
               ([color=BLUE]cons[/color] 10 a)
              '(40 . 0.0)
               ([color=BLUE]cons[/color] 41 ([color=BLUE]/[/color] ([color=BLUE]distance[/color] a b) 3.0))
               ([color=BLUE]cons[/color] 10 b)
           )
       )
   )
   
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] en ([color=BLUE]car[/color] ([color=BLUE]entsel[/color])))
           ([color=BLUE]cond[/color]
               (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
                   ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
               )
               (   ([color=BLUE]eq[/color] 'ename ([color=BLUE]type[/color] en))
                   ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] en))) [color=MAROON]"ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE,SPLINE"[/color]))
                       ([color=BLUE]princ[/color] [color=MAROON]"\nInvalid Object Selected."[/color])
                   )
               )
           )
       )
   )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color] en
           ([color=BLUE]setq[/color] pt
               ([color=BLUE]getpoint[/color] [color=MAROON]"\nSpecify Dimension Offset: "[/color]
                   ([color=BLUE]trans[/color]
                       ([color=BLUE]vlax-curve-getpointatparam[/color] en
                           ([color=BLUE]/[/color] ([color=BLUE]+[/color] ([color=BLUE]vlax-curve-getendparam[/color] en) ([color=BLUE]vlax-curve-getstartparam[/color] en)) 2.0)
                       )
                       0 1
                   )
               )
           )
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] el ([color=BLUE]entlast[/color])
                 cm ([color=BLUE]getvar[/color] 'cmdecho)
           )
           ([color=BLUE]setvar[/color] 'cmdecho 0)
           ([color=BLUE]command[/color] [color=MAROON]"_.offset"[/color] [color=MAROON]"_T"[/color] en [color=MAROON]"_non"[/color] pt [color=MAROON]""[/color])
           ([color=BLUE]setvar[/color] 'cmdecho cm)
           ([color=BLUE]if[/color] ([color=BLUE]equal[/color] el ([color=BLUE]setq[/color] el ([color=BLUE]entlast[/color])))
               ([color=BLUE]princ[/color] [color=MAROON]"\nUnable to Create Dimension Line."[/color])
               ([color=BLUE]progn[/color]
                   ([color=BLUE]setq[/color] a ([color=BLUE]vlax-curve-getstartpoint[/color] en)
                         b ([color=BLUE]vlax-curve-getstartpoint[/color] el)
                   )
                   (_line
                       ([color=BLUE]polar[/color] a ([color=BLUE]angle[/color] a b) ([color=BLUE]/[/color] ([color=BLUE]distance[/color] a b) 6.0))
                       ([color=BLUE]polar[/color] b ([color=BLUE]angle[/color] a b) ([color=BLUE]/[/color] ([color=BLUE]distance[/color] a b) 6.0))
                   )
                   ([color=BLUE]setq[/color] a ([color=BLUE]vlax-curve-getendpoint[/color] en)
                         b ([color=BLUE]vlax-curve-getendpoint[/color] el)
                   )
                   (_line
                       ([color=BLUE]polar[/color] a ([color=BLUE]angle[/color] a b) ([color=BLUE]/[/color] ([color=BLUE]distance[/color] a b) 6.0))
                       ([color=BLUE]polar[/color] b ([color=BLUE]angle[/color] a b) ([color=BLUE]/[/color] ([color=BLUE]distance[/color] a b) 6.0))
                   )
                   (_arrow
                       ([color=BLUE]vlax-curve-getstartpoint[/color] el)
                       ([color=BLUE]polar[/color] ([color=BLUE]vlax-curve-getstartpoint[/color] el)
                           ([color=BLUE]angle[/color] '(0.0 0.0 0.0) ([color=BLUE]vlax-curve-getfirstderiv[/color] el ([color=BLUE]vlax-curve-getstartparam[/color] el)))
                           ([color=BLUE]getvar[/color] 'dimasz)
                       )
                   )
                   (_arrow
                       ([color=BLUE]vlax-curve-getendpoint[/color] el)
                       ([color=BLUE]polar[/color] ([color=BLUE]vlax-curve-getendpoint[/color] el)
                           ([color=BLUE]+[/color] [color=BLUE]pi[/color] ([color=BLUE]angle[/color] '(0.0 0.0 0.0) ([color=BLUE]vlax-curve-getfirstderiv[/color] el ([color=BLUE]vlax-curve-getendparam[/color] el))))
                           ([color=BLUE]getvar[/color] 'dimasz)
                       )
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Link to comment
Share on other sites

WOW, you are the MAN!!!! Thanks so much for this :)

 

Just wondering, how do I change the size of the arrow heads?

Link to comment
Share on other sites

Cheers guys :beer:

 

Just wondering, how do I change the size of the arrow heads?

 

I've set the size to be dependent on the size of the arrows in your Dimension Style, specifically the DIMASZ System Variable.

Link to comment
Share on other sites

Ok, brilliant, thanks for the lisp. I look at these lisps and just admire how clever you guys must be if you can write these. Looks so complicated :P

Link to comment
Share on other sites

; =============================================================================

; Filename : DimPoly.lsp

; Datum : 08.03.06

; Author : jme

; Copyright : MENZI ENGINEERING GmbH, Switzerland

; Revision 1 : 10.03.06 jme - DIMBLK1/2, DIMSE1/2 and DIMDLE support added

; - Bug Text rotation fixed

; - Code refined

; Revision 2 : 13.03.06 jme - Bug attribute insertion point fixed

; - Flag 70 excluded in Spline flag check

; Revision 3 : __.__.__ ___ -

; ----------------------------------------------------------

Link to comment
Share on other sites

Here is one from my oldies, give that a try

 
;;;Programm for the dimensioning of all the polygon/polyline segments
;;;Polyline must be closed or opened
;;;Copyrights (c) 2005 Fatty T.O.H. * all rights removed
;;;A2005 / Windows XP
;;;Thanks to Juergen Menzi:
;;;http://www.menziengineering.ch/
;;;for the math part for the calculation of bulge
;;;and to Matt W. for correction
;;; possible macros for button:
;;; ^C^C^P(progn (terpri)(if (not C:DMP)(load "dmp"))(princ)(C:DMP))
;; helpers : 

;;======groupping list ======;;

(defun group-by-num (lst num / ls ret)
 (if (= (rem (length lst) num ) 0)
   (progn
     (setq ls nil)
     (repeat (/ (length lst) num)
(repeat num (setq ls 
     (cons (car lst) ls)
      lst (cdr lst)))
(setq ret (append ret (list (reverse ls)))
      ls nil)))
   )
ret
 )

;;======= get coordinates =======;;

(defun get-vexs (pline_obj / verts)
     (setq verts (vlax-get pline_obj 'Coordinates)
    verts
   (cond
     ((wcmatch (vlax-get pline_obj 'Objectname )
       "AcDb2dPolyline,AcDb3dPolyline") 
      (group-by-num verts 3)
     )
     ((eq (vlax-get pline_obj 'Objectname )
       "AcDbPolyline") 
      (group-by-num verts 2)
     )
     (T nil)
   )
)
 ) 


;;======= get included angle =======;;

(defun dif-angle (ang1 ang2 / def)
 (set 'ang1
      (if (> ang2 (+ pi ang1))
 (+ (* pi 2) ang1)
 ang1
      )
 )
 (set 'ang2
      (if (> ang1 (+ pi ang2))
 (+ (* pi 2) ang2)
 ang2
      )
 )
 (setq def (- ang2 ang1))
)

;;======= CW-CCW test =======;;
;; (angdir=0)
(defun ccw-test (pt_list / angle_list)
 (setq angle_list
 (mapcar (function (lambda (x y)
       (angle x y)
     )
  )
  pt_list
  (cdr pt_list)
 )
 )
 (if (> (apply '+
 (mapcar (function (lambda (x y) (dif-angle x y)))
  angle_list
  (cdr angle_list)
 )
 )
 0
     )
   t
   nil
 )
)
;; ***  main programm  ***

(defun C:dmp (/ *Error* *Debug*  acsp adoc blg cen chord coors
        dm dop ent gap hgt mid param_list pl rad ss txp)
;Fatty () 2005  
;thanks to Robert R.Bell for the credit of error handler function
 (vl-load-com)
 (defun *Error* (msg)
 (cond ((not msg))
((member msg '("Function cancelled" "quit / exit abort")))
((princ (strcat "\nError: " msg))
 (cond (*Debug* (vl-bt)))
)
 )
 (vla-endundomark
(vla-get-activedocument (vlax-get-acad-object))
     )
)
 (if (< (atof (getvar "ACADVER")) 15.06)
 (alert "Impossible to use this lisp \nin version less than A2000")
 (progn
 (vl-load-com)
 (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
 (or acsp (setq acsp
   (if (or (= (getvar "TILEMODE") 1)
    (> (getvar "CVPORT") 1))
 (vla-get-modelspace adoc)
 (vla-get-paperspace adoc)
 )
)
     )
 (vla-startundomark
adoc
     )
 (if 
 (setq ss (ssget "_:S:E:L" '((0 . "*POLYLINE"))))
 (progn  
 (setq pl (vlax-ename->vla-object
     (ssname ss 0)
   )
 )
(setq coors (get-vexs pl))
 (if (eq :vlax-true (vla-get-closed pl))
 (setq coors (append coors (list (car coors)))))
 (if (ccw-test coors)(setq dop pi)(setq dop 0)) 
(setq param_list (mapcar (function (lambda (x)
 (fix (vlax-curve-getparamatpoint pl x))))
     (mapcar (function (lambda (y)(trans y 0 1))) coors)))
(setq gap (getvar "dimtxt"))
(mapcar (function (lambda (x y z)  
(cond
((not (zerop (setq blg (vla-getbulge pl x))))
(progn
(setq hgt (* 4 (atan (abs blg)))
chord (distance y z)
rad (abs (/ chord 2 (sin (/ hgt 2))))
mid (trans (vlax-curve-getpointatparam pl (+ (fix x) 0.5)) 0 1)
cen (trans (polar y (if (minusp blg)(-(angle y z)(-(/ pi 2)(/ hgt 2)))
       (+(angle y z)(-(/ pi 2)(/ hgt 2)))) rad) 0 1)
txp (trans (polar mid (if (minusp blg)(angle cen mid)
  (angle mid cen)) gap) 0 1)
)
(setq dm (vla-adddim3pointangular acsp
   (vlax-3d-point cen)
   (vlax-3d-point y)
   (vlax-3d-point z)
   (vlax-3d-point txp)))
(vla-put-textoverride dm (rtos (abs (- (vlax-curve-getdistatpoint pl y)
         (vlax-curve-getdistatpoint pl z))) 2 2)))
)
(T (progn
    (setq mid (trans (vlax-curve-getpointatparam pl (+ (fix x) 0.5)) 0 1))
    (setq txp (trans (polar mid (+ dop (angle y z) (/ pi 2)) gap) 0 1))
    (vla-adddimaligned acsp 
   (vlax-3d-point y)
   (vlax-3d-point z)
   (vlax-3d-point txp))

)
))))
param_list
coors
(cdr coors)))
 )
 )
   )
 (vla-endundomark
   adoc
 )
 (*Error* nil)  
 (princ)
)

(prompt "\n\t***\tProgramm loaded\t***\n")
(prompt "\nStart command with DMP\n")
(princ)

 

~'J'~

Link to comment
Share on other sites

  • 1 year later...

@LEEMAC...

Thank you for your "dimcurve" lsp.. if its not too much to ask. can you also add measurement text to you lisp. Thank you

Link to comment
Share on other sites

  • 11 months later...
asos2000 said:
Brilliant.

But the measurement text not shown.

 

jtiwari91 said:
@LEEMAC...

Thank you for your "dimcurve" lsp.. if its not too much to ask. can you also add measurement text to you lisp. Thank you

 

Please try the following modification:

;; Dimension Curve  -  Lee Mac 2012
(defun c:dimcurve ( / _line _arrow a b cm el en p q pt )

   (defun _line ( a b )
       (entmake (list '(0 . "LINE") (cons 10 a) (cons 11 b)))
   )
   
   (defun _arrow ( a b )
       (entmake
           (list
              '(0 . "LWPOLYLINE")
              '(100 . "AcDbEntity")
              '(100 . "AcDbPolyline")
              '(90 . 2)
              '(70 . 0)
               (cons 10 a)
              '(40 . 0.0)
               (cons 41 (/ (distance a b) 3.0))
               (cons 10 b)
           )
       )
   )
   
   (while
       (progn (setvar 'errno 0) (setq en (car (entsel)))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (eq 'ename (type en))
                   (if (not (wcmatch (cdr (assoc 0 (entget en))) "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE,SPLINE"))
                       (princ "\nInvalid Object Selected.")
                   )
               )
           )
       )
   )
   (if
       (and en
           (setq pt
               (getpoint "\nSpecify Dimension Offset: "
                   (trans
                       (vlax-curve-getpointatparam en
                           (/ (+ (vlax-curve-getendparam en) (vlax-curve-getstartparam en)) 2.0)
                       )
                       0 1
                   )
               )
           )
       )
       (progn
           (setq el (entlast)
                 cm (getvar 'cmdecho)
           )
           (setvar 'cmdecho 0)
           (command "_.offset" "_T" en "_non" pt "")
           (setvar 'cmdecho cm)
           (if (equal el (setq el (entlast)))
               (princ "\nUnable to Create Dimension Line.")
               (progn
                   (setq a (vlax-curve-getstartpoint en)
                         b (vlax-curve-getstartpoint el)
                   )
                   (_line
                       (polar a (angle a b) (/ (distance a b) 6.0))
                       (polar b (angle a b) (/ (distance a b) 6.0))
                   )
                   (setq a (vlax-curve-getendpoint en)
                         b (vlax-curve-getendpoint el)
                   )
                   (_line
                       (polar a (angle a b) (/ (distance a b) 6.0))
                       (polar b (angle a b) (/ (distance a b) 6.0))
                   )
                   (_arrow
                       (vlax-curve-getstartpoint el)
                       (polar (vlax-curve-getstartpoint el)
                           (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv el (vlax-curve-getstartparam el)))
                           (getvar 'dimasz)
                       )
                   )
                   (_arrow
                       (vlax-curve-getendpoint el)
                       (polar (vlax-curve-getendpoint el)
                           (+ pi (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv el (vlax-curve-getendparam el))))
                           (getvar 'dimasz)
                       )
                   )
                   (setq a (vlax-curve-getpointatdist el (/ (vlax-curve-getdistatparam el (vlax-curve-getendparam el)) 2.0))
                         b (angle '(0.0 0.0) (vlax-curve-getfirstderiv el (vlax-curve-getparamatpoint el a)))
                         p (polar a (+ b (/ pi 2.0)) (getvar 'dimtxt))
                         q (polar a (- b (/ pi 2.0)) (getvar 'dimtxt))
                   )
                   (if (< (distance p (vlax-curve-getclosestpointto en p))
                          (distance q (vlax-curve-getclosestpointto en q))
                       )
                       (setq p q)
                   )
                   (entmake
                       (list
                          '(000 . "TEXT")
                           (cons 10 p)
                           (cons 11 p)
                           (cons 40 (getvar 'dimtxt))
                           (cons 01 (rtos (vlax-curve-getdistatparam en (vlax-curve-getendparam en))))
                           (cons 50 (LM:readable b))
                          '(072 . 1)
                          '(073 . 2)
                       )
                   )
               )
           )
       )
   )
   (princ)
)

;; Readable  -  Lee Mac
;; Returns an angle corrected for text readability.

(defun LM:readable ( a )
   (   (lambda ( a )
           (if (< a 0.0)
               (LM:readable a)
               (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
                   (LM:readable (+ a pi))
                   a
               )
           )
       )
       (rem (+ a pi pi) (+ pi pi))
   )
)

(vl-load-com) (princ)
 
Edited by Lee Mac
Link to comment
Share on other sites

  • 4 years later...

@Lee Mac

 

i must be doing something wrong as i cant get this to run as i keep getting the an error message saying: extra cdrs in dotted pair on input

 

can you advise me on how to fix this because i'm way out of my depth with this one

Link to comment
Share on other sites

The update to the forum software had corrupted the code formatting - I've now fixed this and have edited the code in the above post.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...