Jump to content

Dimension placement and block insertion


aschiffer

Recommended Posts

Hey, I work with a lot of 2-D drawings that require a bunch of dimensioning and symbol placement. The pictures attached below show what I’m being sent and where the final product ends up. I’m hoping to take a lot of the human element out of the process and have been exploring automation through lisps.

 

The following lisp provided by Kim Engineering Solutions seems like it does exactly what I’m looking for, with the sole problem being that the dimensions are placed right over the line segment they correspond to. Is there any way edit the code to move them out/away from the polylined shape being dimensioned some arbitrary distance, say like 3”? There’s an option box that can be opened when the command is executed but it doesn’t seem to offer what I need.

 

; AutoDimension polylines
; - draw dimension(s) from vertex to vertex for selected polylines
; - add arc length for arc segments.
; Stefan M. 10.11.2015 - for KimProjects.com

(defun C:AD ( / *error* a acdoc b c d dim e fd ht i o p1 p2 p3 pc pm rad sd space ss u opt isLine)
 (setq acDoc (vla-get-activedocument (vlax-get-acad-object))
       space (vlax-get acDoc (if (= (getvar 'cvport) 1) 'paperspase 'modelspace))
       dim (getvar 'dimstyle)
       ht  (* 1.0 (getvar 'dimtxt) (if (= 0 (getvar 'dimanno)) (getvar 'dimscale) (/ 1.0 (getvar 'cannoscalevalue))))
       )
 (vla-startundomark acDoc)

 (defun *error* (msg)
   (and
     msg
     (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
     (princ (strcat "\nADError: " msg))
     )
   (vla-endundomark acdoc)
   (princ)
   )
 
 (setq opt (mapcar
             '(lambda (a b)
                (cond
                  ((getdictvar "AD_otions" a))
                  ((setdictvar "AD_otions" a b))
                  )
                )
             '("Linear" "Arc")
             '("b0" "c0")
             )
       )
 
 (initget "Options")
 (if
   (eq (getkword "\nPress enter to continue or [Options]: ") "Options")
   (setq opt (AD_options opt))
   )
 
 (if
   (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
   (repeat (setq i (sslength ss))
     (setq e (ssname ss (setq i (1- i)))
           o (vlax-ename->vla-object e)
           a (vlax-curve-getstartparam e)
           c (vlax-curve-getendparam   e)
           b nil
           isLine (wcmatch (vla-get-Objectname o) "AcDbLine,AcDbArc")
           )
     (while (<= (setq b (if isLine (if b (1+ b) c) (1+ a))) c)
       (setq p1 (vlax-curve-getpointatparam e a)
             p2 (vlax-curve-getpointatparam e b)
             u  (angle p1 p2)
             pm (vlax-curve-getpointatparam e (/ (+ a b) 2.0))
             sd (vlax-curve-getsecondderiv  e (/ (+ a b) 2.0))
             rad (distance '(0 0 0) sd)
             d  (cond (isLine) ((not (minusp (vla-getbulge o a)))))
             pc (mapcar (if d '+ '-) pm sd)
             p3 (if
                  (or (equal rad 0.0 1e- (eq (cadr opt) "c2"))
                  (if
                    (eq (car opt) "b0")
                    (polar pm (+ (atan (/ (sin u) (cos u))) (/ pi 2.0)) ht)
                    (polar pm (- (atan (/ (sin u) (cos u))) (/ pi 2.0)) (* 1.75 ht))
                    )
                  (if
                    (eq (cadr opt) "c0")
                    (polar pm (angle pm pc) (if (<= 1e-4 (angle pc pm) pi) (* 1.75 ht) ht))
                    (polar pm (angle pc pm) (if (<= 1e-4 (angle pc pm) pi) ht (* 1.75 ht)))
                  )
                )
              )
       (if
         (equal rad 0.0 1e-
         (vla-adddimaligned space (vlax-3d-point p1) (vlax-3d-point p2) (vlax-3d-point p3))
         (vla-adddimarc space (vlax-3d-point pc) (vlax-3d-point p1) (vlax-3d-point p2) (vlax-3d-point p3))
         )
       (setq a (1+ a))
       )
     )
   )
 (vla-endundomark acdoc)
 (princ)
 )

(defun AD_options (old / a1 a2 b1 b2 dcl dcl_id file r)
 (setq
   a1 (car old)
   a2 (cadr old)
   dcl (open (setq file (vl-filename-mktemp "AD" (getvar 'dwgprefix) ".dcl")) "w")
 )
 (write-line
   "AD: dialog { label = \"Dimension Polyline Options\" ;
   : boxed_radio_column { label = \"Linear dimension position\" ; key = \"a1\";
   : radio_button { label = \"Above line\" ; key = \"b0\";}
   : radio_button { label = \"Below line\" ; key = \"b1\";}}
   : boxed_radio_column { label = \"Arc dimension position\" ; key = \"a2\";
   : radio_button { label = \"Inside arc\" ; key = \"c0\";}
   : radio_button { label = \"Outside arc\" ; key = \"c1\";}
   : radio_button { label = \"As for lines\" ; key = \"c2\";}}
   ok_cancel ;}"
   dcl)
 (close dcl)
 (if
   (< 0 (setq dcl_id (load_dialog file)))
   (if
     (new_dialog "AD" dcl_id)
     (progn
       (action_tile "a1" "(setq b1 $value)")
       (action_tile "a2" "(setq b2 $value)")
       (set_tile "a1" (setq b1 a1))
       (set_tile "a2" (setq b2 a2))
       (setq r (start_dialog))
       (unload_dialog dcl_id)
       )
     )
   )
 (if (findfile file) (vl-file-delete file))
 (if
   (= r 1)
   (mapcar 'setdictvar 
     '("AD_otions" "AD_otions")
     '("Linear" "Arc")
     (list b1 b2)
   )
   (list a1 a2)
 )
)
   
(defun getdictvar (dict var / dict_ename)
 (if
   (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
   (cdr (assoc 1 (dictsearch dict_ename var)))
 )
)

(defun setdictvar (dict var val / dict_name record)
 (or
   (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
   (setq dict_ename (dictadd (namedobjdict) dict (entmakex '((0 . "DICTIONARY") (100 . "AcDbDictionary")))))
   )
 (if
   (setq record (dictsearch dict_ename var))
   (entmod (subst (cons 1 val) (assoc 1 record) record))
   (dictadd
     dict_ename
     var
     (entmakex
       (list
         '(0 . "DICTIONARYVAR")
         '(100 . "DictionaryVariables")
         '(280 . 0)
         (cons 1 val)
       )
     )
   )
 )
 val
)

 

 

 

Additionally, the symbols that are added on some of the line segments between pictures 1 and 2 are super helpful when we print these drawings off in black and white and the layer colors are not easily discernible. Is it possible to create a lisp where I can select a line segment, then a block from a base point, and have it populate the block from that basepoint at the midpoint of each line segment on the chosen layer?

 

Any help here would be very much appreciated!

1.jpg

2.jpg

Link to comment
Share on other sites

  • 2 weeks later...

Offset options added to the options window

 

optins.png

 

; AutoDimension polylines
; - draw dimension(s) from vertex to vertex for selected polylines
; - add arc length for arc segments.
; Stefan M. 10.11.2015 - for KimProjects.com

(defun C:AD ( / *error* a acdoc b c d dim e fd ht i o p1 p2 p3 pc pm rad sd space ss u isLine off)
 (setq acDoc (vla-get-activedocument (vlax-get-acad-object))
       space (vlax-get acDoc (if (= (getvar 'cvport) 1) 'paperspase 'modelspace))
       dim (getvar 'dimstyle)
       ;ht  (* 1.0 (getvar 'dimtxt) (if (= 0 (getvar 'dimanno)) (getvar 'dimscale) (/ 1.0 (getvar 'cannoscalevalue))))
       )
 (vla-startundomark acDoc)

 (defun *error* (msg)
   (and
     msg
     (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
     (princ (strcat "\nADError: " msg))
     )
   (vla-endundomark acdoc)
   (princ)
   )
 
 (setq opt (mapcar
             '(lambda (a b)
                (cond
                  ((getdictvar "AD_otions" a))
                  ((setdictvar "AD_otions" a b))
                  )
                )
             '("Linear" "Arc" "offset")
             '("b0" "c0" "d0")
             )
       )
(setq kopt opt)
 
 (initget "Options")
 (if
   (eq (getkword "\nPress enter to continue or [Options]: ") "Options")
   (setq opt (AD_options opt))
   )
(setq a3 (nth 2 opt))
(setq off (* (1+ (read (substr a3 2 3))) 0.25))
 
 (if
   (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
   (repeat (setq i (sslength ss))
     (setq e (ssname ss (setq i (1- i)))
           o (vlax-ename->vla-object e)
           a (vlax-curve-getstartparam e)
           c (vlax-curve-getendparam   e)
           b nil
           isLine (wcmatch (vla-get-Objectname o) "AcDbLine,AcDbArc")
           )
     (while (<= (setq b (if isLine (if b (1+ b) c) (1+ a))) c)
       (setq p1 (vlax-curve-getpointatparam e a)
             p2 (vlax-curve-getpointatparam e b)
             u  (angle p1 p2)
             pm (vlax-curve-getpointatparam e (/ (+ a b) 2.0))
             sd (vlax-curve-getsecondderiv  e (/ (+ a b) 2.0))
             rad (distance '(0 0 0) sd)
             d  (cond (isLine) ((not (minusp (vla-getbulge o a)))))
             pc (mapcar (if d '+ '-) pm sd)
             p3 (if
                  (or (equal rad 0.0 1e- (eq (cadr opt) "c2"))
                  (if
                    (eq (car opt) "b0")
                    (polar pm (+ (atan (/ (sin u) (cos u))) (/ pi 2.0)) off)
                    (polar pm (- (atan (/ (sin u) (cos u))) (/ pi 2.0)) off)
                    )
                  (if
                    (eq (cadr opt) "c0")
                    (polar pm (angle pm pc) (if (<= 1e-4 (angle pc pm) pi) (* 1.75 off) off))
                    (polar pm (angle pc pm) (if (<= 1e-4 (angle pc pm) pi) off (* 1.75 off)))
                  )
                )
              )
       (if
         (equal rad 0.0 1e-
         (progn (vla-adddimaligned space (vlax-3d-point p1) (vlax-3d-point p2) (vlax-3d-point p3)))
         (progn (vla-adddimarc space (vlax-3d-point pc) (vlax-3d-point p1) (vlax-3d-point p2) (vlax-3d-point p3)))
         )
       (setq a (1+ a))
       )
     )
   )
 (vla-endundomark acdoc)
 (princ)
 )

(defun AD_options (old / a1 a2 a3  b1 b2 b3 dcl dcl_id file r)
 (setq
   kold old 
   a1 (nth 0 old)
   a2 (nth 1 old)
a3 (nth 2 old)
   dcl (open (setq file (vl-filename-mktemp "AD" (getvar 'dwgprefix) ".dcl")) "w")
 )
 (write-line
   "AD: dialog { label = \"Dimension Polyline Options\" ;
   : boxed_radio_column { label = \"Linear dimension position\" ; key = \"a1\";
   : radio_button { label = \"Above line\" ; key = \"b0\";}
   : radio_button { label = \"Below line\" ; key = \"b1\";}}

   : boxed_radio_column { label = \"Arc dimension position\" ; key = \"a2\";
   : radio_button { label = \"Inside arc\" ; key = \"c0\";}
   : radio_button { label = \"Outside arc\" ; key = \"c1\";}
   : radio_button { label = \"As for lines\" ; key = \"c2\";}}

   : boxed_radio_column { label = \"dimension Offsit (meter)\" ; key = \"a3\";
   : radio_button { label = \"0.25\" ; key = \"d0\";}
   : radio_button { label = \"0.50\" ; key = \"d1\";}
   : radio_button { label = \"0.75\" ; key = \"d2\";}
: radio_button { label = \"1.00\" ; key = \"d3\";}
}

   ok_cancel ;}"
   dcl)
 (close dcl)
 (if
   (< 0 (setq dcl_id (load_dialog file)))
   (if
     (new_dialog "AD" dcl_id)
     (progn
       (action_tile "a1" "(setq b1 $value)")
       (action_tile "a2" "(setq b2 $value)")
	(action_tile "a3" "(setq b3 $value)")
	
       (set_tile "a1" (setq b1 a1))
       (set_tile "a2" (setq b2 a2))
	(set_tile "a3" (setq b3 a3))
	
       (setq r (start_dialog))
       (unload_dialog dcl_id)
       )
     )
   )
 (if (findfile file) (vl-file-delete file))
 (if
   (= r 1)
   (mapcar 'setdictvar 
     '("AD_otions" "AD_otions" "AD_otions")
     '("Linear" "Arc" "offset")
     (list b1 b2 b3)
   )
   (list a1 a2 a3)
 )
)
   
(defun getdictvar (dict var / dict_ename)
 (if
   (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
   (cdr (assoc 1 (dictsearch dict_ename var)))
 )
)

(defun setdictvar (dict var val / dict_name record)
 (or
   (setq dict_ename (cdr (assoc -1 (dictsearch (namedobjdict) dict))))
   (setq dict_ename (dictadd (namedobjdict) dict (entmakex '((0 . "DICTIONARY") (100 . "AcDbDictionary")))))
   )
 (if
   (setq record (dictsearch dict_ename var))
   (entmod (subst (cons 1 val) (assoc 1 record) record))
   (dictadd
     dict_ename
     var
     (entmakex
       (list
         '(0 . "DICTIONARYVAR")
         '(100 . "DictionaryVariables")
         '(280 . 0)
         (cons 1 val)
       )
     )
   )
 )
 val
)

Link to comment
Share on other sites

  • 3 weeks later...

Hey, I'm quite late in responding (just getting back into the swing of things after winter holidays) but I really appreciate the help you've provided, handasa! I spent quite a while trying to understand what it is you altered and how to modify it to my ideal, but I'm way over my head and every time I change the text thinking I'm fixing it the program won't load.

 

Is there any way I can put heighten the offsets of .25/.5/.75/1 to something like 1/3/5/10? And additionally, is there any easy way to adjust where dimensions are being placed? It looks like all generally 'horizontal' dimensions are being placed up form where they're taken by the chosen offset amount. Likewise, all 'vertical' dimensions are offset by the amount chosen, but I don't understand how it's choosing whether to place them right or left.

 

I attached a pair of pictures, "offset" is what I'm currently giving after using your edited program and "ideal" is where I'm really hoping the dimensions end up. That being said, even just upping the offset amount might be enough to make this workable. Thanks so much again for already looking at this once for me and I hope someone out there might be able to tweak it just a tiny bit!

offset.jpg

ideal.jpg

Link to comment
Share on other sites

hi aschiffer , i used the metric units as my country standard .. i will modify the lisp to be more flexible and post it back when it is ready

Link to comment
Share on other sites

AD.rar

 

here it's the update ... the all dimension either will be left&abovelines

or all of them will be right&below lines

 

make sure to put samp5.dcl in autocad search path

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...