Automatic placement of dimensions

I've been experimenting with Tharwat's code from the 1st page of this post and have incorporated it into the code I already had. I am using the point coordinates to place dimensions automatically on a rectangle that has chamfers at the top. My problem now is the dimensions are not being placed as I expect them to. I did find this code by Tharwat on another forum where he uses Visual LISP to place the dimensions.

(defun c:TesT (/ ss n sset p1 y p2 x p3)
 ;;;====== Tharwat 17. Sep. 2011 =====;;;
 (vl-load-com)
 (cond ((not spc)
        (setq spc (vla-get-ModelSpace
                    (vla-get-activedocument (vlax-get-acad-object))
                  )
        )
       )
 )
 (if (setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE"))))
   (progn
     (if (= 4.0 (vlax-curve-getendparam (ssname ss 0)))
       (repeat (setq n (sslength ss))
         (setq sset (ssname ss (setq n (1- n))))
         (setq p1 (vlax-3d-point
                    (setq y (vlax-curve-getpointatparam sset 0))
                  )
         )
         (setq p2 (vlax-3d-point
                    (setq x (vlax-curve-getpointatparam sset 1))
                  )
         )
         (setq p3 (vlax-3d-point (vlax-curve-getpointatparam sset 2)))
         (vla-adddimrotated
           spc
           p1
           p2
           (vlax-3d-point (list (car y) (+ (cadr y) 10.) (caddr y)))
           0.0
         )
         (vla-AddDimAligned
           spc
           p2
           p3
           (vlax-3d-point (list (+ (car x) 10.) (cadr x) (caddr x)))
         )
       )
     )
   )
   (princ)
 )
 (princ)
)

I don't know just quite how to incorporate this code into my code. Is there anyone that can show me how that can be done, if it is possible? Right now, I'm just trying to get just one of the dimensions to display correctly.

The image below is what I am trying to accomplish.

Below is the current code.

(defun SetvariableToEachCoordinate (s / e i); subroutine by Tharwat 1/13/17
 (if (and (eq (type s) 'ENAME)
          (= (cdr (assoc 0 (setq e (entget s)))) "LWPOLYLINE")
          (setq i 0)
          )
   (mapcar '(lambda (x) (set (read (strcat "P" (itoa (setq i (1+ i))))) x)
              (setq l (cons (read (strcat "P" (itoa i))) l))
              )
           (mapcar 'cdr (vl-remove-if-not '(lambda (q) (= (car q) 10)) e))
           )
   )
 (reverse l)
 (setq lofl (length l))
 )

(defun c:dimbox3 ()
 (vl-load-com)
 (cond	((not spc)
 (setq spc (vla-get-ModelSpace
	     (vla-get-activedocument (vlax-get-acad-object))
	   )
 )
)
 )
 (setvar "cmdecho" 0)
 (setq	varlist	'(a b x	 q ss s i en dimdist l lst))
 (foreach var varlist (set var nil))
 (setq factor (getvar "dimscale"))
 (if (zerop (getvar "dimtxt"))
   (setq hgt
   2.5
   )
   (setq hgt (getvar "dimtxt"))
 )
 (setq dimdist (* factor (* 5 hgt)))
 (setq i 0)
 (setq ss (ssget "_X" '((0 . "*POLYLINE") (8 . "0"))))

 (repeat (setq nos (sslength ss))
   (setq lst
   (cons (SetvariableToEachCoordinate
	   (ssname ss (setq nos (1- nos)))
	 )
	 lst
   )
   )
 )					;end repeat

 (command "._dimlinear"
   "_non"
   p3
   "_non"
   p4
   "_non"
   (polar p3 (/ (* 0 pi) 180) dimdist)
 )

 (setvar "cmdecho" 1)
 (princ)
)

Thank you!

Drafter_Joe

If you want to create code for polylines that are all similar to your example it would be doable. But you would still have to analyse the geometry. Any of the points can be the first point, and the direction of the polyline can be CW or CCW. You should not assume a fixed order.

This should get you most of the way there:

([color=BLUE]defun[/color] c:autodimexample ( [color=BLUE]/[/color] an1 an2 elv enx idx lst ocs off sel spc )

   ([color=BLUE]setq[/color] off ([color=BLUE]*[/color] 2.0 ([color=BLUE]getvar[/color] 'dimtxt)))
   
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] sel
           ([color=BLUE]ssget[/color]
              '(   (0 . [color=MAROON]"LWPOLYLINE"[/color])
                   (90 . 6)
                   (-4 . [color=MAROON]"&="[/color])
                   (70 . 1)
                   (-4 . [color=MAROON]"<NOT"[/color])
                       (-4 . [color=MAROON]"<>"[/color])
                       (42 . 0.0)
                   (-4 . [color=MAROON]"NOT>"[/color])
                   (410 . [color=MAROON]"Model"[/color])
               )
           )
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] spc ([color=BLUE]vla-get-modelspace[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))))
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] idx ([color=BLUE]sslength[/color] sel))
               ([color=BLUE]setq[/color] enx ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] idx ([color=BLUE]1-[/color] idx))))
                     elv ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 038 enx))
                     ocs ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 210 enx))
                     lst ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]list[/color] ([color=BLUE]cadr[/color] x) ([color=BLUE]caddr[/color] x) elv)) ([color=BLUE]vl-remove-if-not[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x))) enx))
               )
               ([color=BLUE]if[/color] (LM:listclockwise-p lst) ([color=BLUE]setq[/color] lst ([color=BLUE]reverse[/color] lst)))
               ([color=BLUE]setq[/color] lst
                   (   ([color=BLUE]lambda[/color] ( p [color=BLUE]/[/color] r )
                           ([color=BLUE]append[/color]
                               ([color=BLUE]vl-member-if[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]cond[/color] (([color=BLUE]equal[/color] x p 1e-) (([color=BLUE]setq[/color] r ([color=BLUE]cons[/color] x r)) [color=BLUE]nil[/color]))) lst)
                               ([color=BLUE]reverse[/color] r)
                           )
                       )
                       ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]min[/color] lst))
                   )
                   an1 ([color=BLUE]angle[/color] ([color=BLUE]nth[/color] 0 lst) ([color=BLUE]nth[/color] 1 lst))
                   an2 ([color=BLUE]+[/color] an1 ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.0))
               )
               ([color=BLUE]vla-adddimrotated[/color] spc
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ([color=BLUE]nth[/color] 1 lst) ocs 0))
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ([color=BLUE]nth[/color] 3 lst) ocs 0))
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ([color=BLUE]polar[/color] ([color=BLUE]nth[/color] 1 lst) an1 ([color=BLUE]+[/color] off off)) ocs 0))
                   an2
               )
               ([color=BLUE]vla-adddimrotated[/color] spc
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ([color=BLUE]nth[/color] 3 lst) ocs 0))
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ([color=BLUE]nth[/color] 2 lst) ocs 0))
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ([color=BLUE]polar[/color] ([color=BLUE]nth[/color] 2 lst) an1 off) ocs 0))
                   an2
               )
               ([color=BLUE]vla-adddimrotated[/color] spc
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ([color=BLUE]nth[/color] 5 lst) ocs 0))
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ([color=BLUE]nth[/color] 2 lst) ocs 0))
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ([color=BLUE]polar[/color] ([color=BLUE]nth[/color] 5 lst) an2 ([color=BLUE]+[/color] off off)) ocs 0))
                   an1
               )
               ([color=BLUE]vla-adddimrotated[/color] spc
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ([color=BLUE]nth[/color] 3 lst) ocs 0))
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ([color=BLUE]nth[/color] 2 lst) ocs 0))
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ([color=BLUE]polar[/color] ([color=BLUE]nth[/color] 3 lst) an2 off) ocs 0))
                   an1
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; List Clockwise-p - Lee Mac[/color]
[color=GREEN];; Returns T if the point list is clockwise oriented[/color]

([color=BLUE]defun[/color] LM:listclockwise-p ( lst )
   ([color=BLUE]minusp[/color]
       ([color=BLUE]apply[/color] '[color=BLUE]+[/color]
           ([color=BLUE]mapcar[/color]
               ([color=BLUE]function[/color]
                   ([color=BLUE]lambda[/color] ( a b )
                       ([color=BLUE]-[/color] ([color=BLUE]*[/color] ([color=BLUE]car[/color] b) ([color=BLUE]cadr[/color] a)) ([color=BLUE]*[/color] ([color=BLUE]car[/color] a) ([color=BLUE]cadr[/color] b)))
                   )
               )
               lst ([color=BLUE]cons[/color] ([color=BLUE]last[/color] lst) lst)
           )
       )
   )
)

([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

List Clockwise function from here.

Hi Lee,

The more I try dissecting/digesting your full example(s), the more I see what I'm neglecting/missing.

This time this block gets me:

(setq lst
 (   (lambda ( p / r )
   (append
     (vl-member-if '(lambda ( x ) (cond ((equal x p 1e-) ((setq r (cons x r)) nil))) lst)
     (reverse r)
   )
 )
 (apply 'mapcar (cons 'min lst))
 )
)

. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

(apply 'mapcar (cons 'min lst))

^^ I've seen something like this before:

(setq cen (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.)) (mapcar 'vlax-safearray->list (list ll ur)))))

I bet you recognise the above example you gave me.

But doesn't (apply 'mapcar (cons 'min lst)) equals to: (mapcar 'min lst) ?

Or maybe I'm missing something?

And obviously I got some trouble visualising the lambda part:

(lambda ( p / r )
 (append
   (vl-member-if '(lambda ( x ) (cond ((equal x p 1e-) ((setq r (cons x r)) nil))) lst)
   (reverse r)
 )
)

If you don't mind explaining (esp the apply 'mapcar ... part)

Thanks!

Lee I had problems with the ssget I chopped it back to lwpolyline then it worked not sure what I did wrong any one else have a problem ? I will have to look up all the dxf codes to figure it out. Now where is my reference book.

In general I can see 1 problem what happens when you want to dim the left side ? I thought about this and a couple of ideas came forward, use the pick point to define the 1st leg to be dimmed, so compare the vertices to find this point, again a problem once you get to the end of the vertice list you then need to go to the start of the list and keep going for the number of legs. So it would be pick leg and number of segments required. This could be part of the defun name autodim2 autodim3 as the balance of the code would only be needed once.

Maybe a dim all legs and use for accept any key to reject. As part of this check the angle of the two points so use ver and hor, else do both ver & hor.

But doesn't (apply 'mapcar (cons 'min lst)) equals to: (mapcar 'min lst) ?

No -

Given a list:

(setq lst '(<item1> <item2> ... <itemN>))

(mapcar 'min lst) == ((min <item1>) (min <item2>) ... (min <itemN>))

(apply 'mapcar (cons 'min lst)) == ((min (car <item1>) (car <item2>) ... (car <itemN>)) (min (cadr <item1>) (cadr <item2>) ... (cadr <itemN>)) ...)

Lee I had problems with the ssget I chopped it back to lwpolyline then it worked not sure what I did wrong any one else have a problem ? I will have to look up all the dxf codes to figure it out. Now where is my reference book.

The ssget filter will only permit closed LWPolylines with 6 vertices and no arc segments, residing in Modelspace.

Thanks for explaining Lee,

I immediately thought about your LM:ssboundingbox subfunction, and that something like this could be created (doesn't work with INSERTs, but hopefully you get the idea/inspiration):

[b][color=BLACK]([/color][/b]defun VanillaBoundingBox [b][color=FUCHSIA]([/color][/b] SS / i enx lst [b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]eq 'PICKSET [b][color=MAROON]([/color][/b]type SS[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]repeat [b][color=MAROON]([/color][/b]setq i [b][color=GREEN]([/color][/b]sslength SS[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]and [b][color=GREEN]([/color][/b]/= [color=#2f4f4f]"INSERT"[/color] [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 0 [b][color=PURPLE]([/color][/b]setq enx [b][color=TEAL]([/color][/b]entget [b][color=OLIVE]([/color][/b]ssname SS [b][color=GRAY]([/color][/b]setq i [b][color=AQUA]([/color][/b]1- i[b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
       [b][color=GREEN]([/color][/b]setq lst 
         [b][color=BLUE]([/color][/b]append lst 
           [b][color=RED]([/color][/b]apply 'append
             [b][color=PURPLE]([/color][/b]mapcar
               [b][color=TEAL]([/color][/b]function [b][color=OLIVE]([/color][/b]lambda [b][color=GRAY]([/color][/b]x[b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]if [b][color=AQUA]([/color][/b]member [b][color=LIME]([/color][/b]car x[b][color=LIME])[/color][/b] '[b][color=LIME]([/color][/b]10 11[b][color=LIME])[/color][/b][b][color=AQUA])[/color][/b] [b][color=AQUA]([/color][/b]list [b][color=LIME]([/color][/b]cdr x[b][color=LIME])[/color][/b][b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b]
               enx
             [b][color=PURPLE])[/color][/b][color=#8b4513]; mapcar [/color]
           [b][color=RED])[/color][/b][color=#8b4513]; apply 'append[/color]
         [b][color=BLUE])[/color][/b][color=#8b4513]; append lst[/color]
       [b][color=GREEN])[/color][/b][color=#8b4513]; setq [/color]
     [b][color=MAROON])[/color][/b][color=#8b4513]; and[/color]
   [b][color=NAVY])[/color][/b][color=#8b4513]; repeat[/color]
 [b][color=FUCHSIA])[/color][/b][color=#8b4513]; if[/color]
 [b][color=FUCHSIA]([/color][/b]if lst [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]apply 'mapcar [b][color=GREEN]([/color][/b]cons 'min lst[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]apply 'mapcar [b][color=GREEN]([/color][/b]cons 'max lst[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=BLACK])[/color][/b][color=#8b4513]; defun VanillaBoundingBox[/color]

[b][color=BLACK]([/color][/b]defun C:test [b][color=FUCHSIA]([/color][/b] / SS pts [b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]setq SS [b][color=GREEN]([/color][/b]ssget[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq pts [b][color=GREEN]([/color][/b]VanillaBoundingBox SS[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]command [color=#2f4f4f]"_.RECTANGLE"[/color] [color=#2f4f4f]"_non"[/color] [b][color=MAROON]([/color][/b]car pts[b][color=MAROON])[/color][/b] [color=#2f4f4f]"_non"[/color] [b][color=MAROON]([/color][/b]cadr pts[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] [b][color=MAROON]([/color][/b]entlast[b][color=MAROON])[/color][/b] [color=#2f4f4f]""[/color] [color=#2f4f4f]"_C"[/color] 1 [color=#2f4f4f]""[/color][b][color=NAVY])[/color][/b]
 [b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]princ[b][color=FUCHSIA])[/color][/b]
[b][color=BLACK])[/color][/b]

Thanks for explaining Lee

You're welcome.

I immediately thought about your LM:ssboundingbox subfunction, and that something like this could be created (doesn't work with INSERTs, but hopefully you get the idea/inspiration)

A nice idea, but it would be strictly limited to linear objects such as LINEs & straight-segmented LWPOLYLINEs - you would obviously get undesired results for non-linear objects (ARCs, CIRCLEs, ELLIPSEs, SPLINEs & LWPOLYLINEs with arc-segments), and objects for which DXF groups 10 & 11 do not correspond to coordinates which define the geometry (e.g. TEXT, MTEXT and INSERTs - as you've mentioned).

Thanks Lee , I had 5 segments in my test pline. The dxf 90 not something I would have thought about.

Hi Lee!

Great looking code! I will be giving it a try here shortly and get back to this thread with any questions. I appreciate you hard work and dedication to LISP coding. It's great to see other coders chime in on my question and contribute as well! A fabulous learning process!

A big thank you to each of you!

Joe

Lee,

With just a few changes it works excellently for me!

Thank you!

Excellent, you're welcome Joe.