Jump to content

Dimension along a curvy polyline

bigmaz

By bigmaz
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

bigmaz Enthusiast

bigmaz

Posted
Posted

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

Lee Mac Grand Master

Lee Mac

Posted
Posted

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

Dadgad Grand Master

Dadgad

Posted
Posted

I'm guessing somebody's about to be a very happy camper! :) :beer:

bigmaz Enthusiast

bigmaz

Posted
  • Author
Posted

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

 

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

Lee Mac Grand Master

Lee Mac

Posted
Posted

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.

bigmaz Enthusiast

bigmaz

Posted
  • Author
Posted

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

Lee Mac Grand Master

Lee Mac

Posted
Posted

Thank you for your compliments bigmaz, I've had a lot of practice :)

m4rdy Apprentice

m4rdy

Posted
Posted

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

; 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 : __.__.__ ___ -

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

asos2000 Mentor

asos2000

Posted
Posted

Brilliant.

But the measurement text not shown.

fixo Mentor

fixo

Posted
Posted

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'~

Lee Mac Grand Master

Lee Mac

Posted
Posted
But the measurement text not shown.

 

'twas apparently not required...

  • 1 year later...
jtiwari91 Newbie

jtiwari91

Posted
Posted

@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

  • 11 months later...
Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)
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
  • 4 years later...
Sheepskin Newbie

Sheepskin

Posted
Posted

@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

Lee Mac Grand Master

Lee Mac

Posted
Posted

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.

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.

×
 Share
Go to topic listing
×
×
  • Create New...