Dimension along a curvy polyline

[bigmaz]

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]

Had a few minutes and was feeling generous:

;; Dimension Curve  -  Lee Mac 2012
(defun c:dimcurve ( / _line _arrow a b cm el en 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)
                        )
                    )
                )
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)

[Dadgad]

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

[bigmaz]

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

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

[Lee Mac]

Cheers guys

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]

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

[Lee Mac]

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

[m4rdy]

; ================================================== ===========================
; 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]

Brilliant.
But the measurement text not shown.

[fixo]

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