Jump to content

Automatic placement of dimensions

drafter_joe

By drafter_joe
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

drafter_joe Contributor

drafter_joe

Posted
Posted

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.

rect cham dims.PNG

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

Roy_043 Mentor

Roy_043

Posted
Posted

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.

Lee Mac Grand Master

Lee Mac

Posted
Posted

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.

Grrr Veteran

Grrr

Posted
Posted

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!

BIGAL Grand Master

BIGAL

Posted
Posted

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.

Lee Mac Grand Master

Lee Mac

Posted
Posted
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 Mac Grand Master

Lee Mac

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

Grrr Veteran

Grrr

Posted
Posted

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]

Lee Mac Grand Master

Lee Mac

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

BIGAL Grand Master

BIGAL

Posted
Posted

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

drafter_joe Contributor

drafter_joe

Posted
  • Author
Posted

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

drafter_joe Contributor

drafter_joe

Posted
  • Author
Posted

Lee,

 

With just a few changes it works excellently for me!

 

Thank you!

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