AUTO DIMENSIONS AND TEXT

[Ciupanezul21]

Good day, ladies and gentlemen

I am a design engineer at a furniture factory and I have been working in autocad for about 7 years and the work has become quite difficult, many tasks in a short time and I saw that there are autolips automations and I was wondering if you could help me with an autolips for Auto quotes Dimensions to optimize my production time. I will show you in a few pictures how I would like this Autolips. I would be very grateful.

 

More details

* annotation Dimensions must be in steps

* the measured diameter should be in letters And generating a text to extract the quantity and value of these holes near the part.

DOOR 600.dwg

[BIGAL]

I would look at the front end I have a 2 column getvals but could do a 3 column version these are Library code so can be used in any software. You would pick a corner eg LL lower left, then enter in the dcl 3 values the X Y & Alpha. Oh yeah 1st go would be just enter overall size and the radius values A= 4 

 

So custom dcls may be easier with more than one enter as a sequence. Something like this.

 

 

Could do with a simpler getreal but if make one mistake have to do all again.

 

Its going to take some time to do as a number of steps required. You may have to pay for this type of custom program. There are many of us here who can help.

 

Are there more than 4 entries per corner ? Its not a problem can display up to about 20. 

 

 

Edited September 21, 2023 by BIGAL

[Ciupanezul21]

Thanks @BIGAL for the help, but in the meantime I succeededuntil the end I managed to do it ok

 

 

(defun c:AUTODIMENSIONARE (/ *error* dxfGroup getPLPoints MkBoundingBox growBound orgCoords nearCor findBL plineOrg sublist k*bulge rtd dist ang distHor distVer getMid drawDim drawDiam echo os pre style lay i j k entAll entCurr shape ConturBorder ConturBorderPts bounding ofstTYP holes fuzz A B C D E F G H )
    (vl-load-com)
    (setq    echo    (getvar "CMDECHO")
            os        (getvar "OSMODE")
            pre        (getvar "DIMPOST")
            style    (getvar "DIMTXSTY")
            lay        (getvar "CLAYER")
    );setq
    
    (defun *error* (msg)
        (setvar "CMDECHO" echo)
        (setvar "OSMODE" os)
        (setvar "DIMPOST" pre)
        (setvar "DIMTXSTY" style)
        (setvar "CLAYER" lay)
        (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
        (if (and msg
                (null (member msg '("Function cancelled" "quit / exit abort")))
            );and
            (progn (alert (strcat "\nError Processing Shape:\n" msg)) (setvar "CMDECHO" 0) (command-s "_.UNDO" "") (setvar "CMDECHO" echo))
        );if
        (exit)
    );defun
    
    (defun dxfGroup (code entCurr)
     ;Returns the value in a specified DXF Group Code
     ;Refer to http://www.jefferypsanders.com/autolispintr_dxftbl.html for group codes
     ;code        :    Int - The group code associated value to lookup
     ;entCurr    :    Entity - The entity to look up a code in
     ;Returns    :    Various - Returns the value associated with the group code
        (cdr(assoc code (entget entCurr)))
    );defun
    
    (defun getPLPoints (pl / a b)
     ;Creates a list of coordinates for all the vertexes in a given polyline
     ;May need to follow up with orgCoords below to ensure that the points are in order
     ;pl        :    Entity - A polyline entity in the drawing
     ;Returns    :    List - A list of coordinates ((x1 y1) (x2 y2) ...) in the polyline
        (setq b (list))
        (foreach a pl
            (if(= 10 (car a))
                (setq b
                    (append b
                        (list (cdr a))
                    );append
                );setq
            );if
        );foreach
        b
    );defun
    
    (defun MkBoundingBox (pts / a minX minY maxX maxY)
     ;Creates a bounding box around the furthest points of a polyline
     ;TODO: make this recognize arcs in a polyline and treat them appropriately
     ;pts        :    List - A list of coordinates ((x1 y1) (x2 y2) ...) in a polyline (does NOT accept a polyline entity)
     ;Returns    :    List - A list of coordinates ((x1 y1) (x2 y2)) that make up a bounding box
        (foreach a pts
            (if (or (= minX nil)(< (car a)    minX)) (setq minX (car a)))  
            (if (or (= minY nil)(< (cadr a)    minY)) (setq minY (cadr a)))
            (if (or (= maxX nil)(> (car a)    maxX)) (setq maxX (car a)))
            (if (or (= maxY nil)(> (cadr a)    maxY)) (setq maxY (cadr a)))
        );foreach
        (list (list minX minY) (list maxX maxY))
    );defun
    
    (defun growBound (bounding side amount)
     ;Grows a bounding box by specified amount in specified direction.
     ;bounding    :    List - A list of coordinates ((x1 y1) (x2 y2)) that make up a bounding box
     ;side        :    String - A string specifying what side to grow the box (accepts "left", "bottom", "right", "top", "all")
     ;amount    :    Int - An integer for how many units to grow the box (set to 0 for default value)
     ;Returns    :    List - A new list of coordinates ((x1 y1) (x2 y2)) for the expanded bounding box
        (if
            (= amount 0)
            (setq amount ofstTYP)
             ;Default amount is 3 inches between Dimensiuni for imperial drawings.
             ;This ensures that linetypes align on the Dimensiuni' extension lines
        );if
        (setq bounding
            (list
                (list
                    (if (or (= side "all") (= side "left"))
                        (- (car (car bounding)) amount)
                           (car (car bounding)) ;left
                    );if
                    (if (or (= side "all") (= side "bottom"))
                        (- (cadr (car bounding)) amount)
                           (cadr (car bounding))
                    );if
                );list
                (list
                    (if (or (= side "all") (= side "right"))
                        (+ (car (cadr bounding)) amount)
                           (car (cadr bounding))
                    );if
                    (if (or (= side "all") (= side "top"))
                        (+ (cadr (cadr bounding)) amount)
                           (cadr (cadr bounding))
                    );if
                );list
            );list
        );setq
        bounding
    );defun
    
    (defun orgCoords (lst corner /)
     ;Accepts a list of coordinates and a "corner" in form of string as a sorting priority.
     ;Sorting priority should be "BL" (Bottom Left), "TR" (Top Right), "LT" (Left Top), etc.
     ;First letter in sorting priority will have higher weight than second when values are equal
     ;e.g. BL will put the smallest Y values first. If two Y values are equal, it will sort by smallest X
     ;     LB will put the smallest X values first. If two X values are equal, it will sort by smallest Y
     ;lst        :    List - A list of coordinates ((x1 y1) (x2 y2) ...) for sorting
     ;corner    :    String - A string specifying corner sorting priority
     ;Returns    :    List - A sorted list of coordinates ((x1 y1) (x2 y2) ...)
        (defun compare-points (a b)
            (cond
                ( (= corner "BL") (if (equal (cadr a) (cadr b) fuzz) (< (car a)  (car b) ) (< (cadr a) (cadr b))) )
                ( (= corner "BR") (if (equal (cadr a) (cadr b) fuzz) (> (car a)  (car b) ) (< (cadr a) (cadr b))) )
                ( (= corner "TL") (if (equal (cadr a) (cadr b) fuzz) (< (car a)  (car b) ) (> (cadr a) (cadr b))) )
                ( (= corner "TR") (if (equal (cadr a) (cadr b) fuzz) (> (car a)  (car b) ) (> (cadr a) (cadr b))) )
                ( (= corner "LB") (if (equal (car a)  (car b) fuzz)  (< (cadr a) (cadr b)) (< (car a)  (car b) )) )
                ( (= corner "RB") (if (equal (car a)  (car b) fuzz)  (< (cadr a) (cadr b)) (> (car a)  (car b) )) )
                ( (= corner "LT") (if (equal (car a)  (car b) fuzz)  (> (cadr a) (cadr b)) (< (car a)  (car b) )) )
                ( (= corner "RT") (if (equal (car a)  (car b) fuzz)  (> (cadr a) (cadr b)) (> (car a)  (car b) )) )
            );cond
        );defun
    (vl-sort lst 'compare-points)
    );defun
    
    (defun nearCor (coor / j x)
     ;Find the coordinates of the nearest corner on ConturBorderPts to the given coords (x y)
     ;coor        :    List - Coordinates (x y) to check
     ;Returns    :    List - Coordinates (x y) of nearest corner on ConturBorderPts
        (setq x (car ConturBorderPts))
        (foreach j (cdr ConturBorderPts)
            (if (< (dist coor j) (dist coor x)) (setq x j))
        );foreach
        x
    );defun
    
    (defun findBL (pl / a b c)
     ;Find the coordinates of the bottom-left most point on a polyline
     ;finds smallest Y-Value first, then smallest X-Value
     ;pl        :    List - a list of coordinates ((x1 y1) (x2 y2) ...) in a polyline (does NOT accept a polyline entity)
     ;Returns    :    List - Coordinates (x y) of the bottom-left most corner
        (foreach a pl (if (or (= b nil)(< (cadr a) b)) (setq b (cadr a))))
        (foreach a pl (if (= b (cadr a)) (if (or (= c nil)(< (car a) c)) (setq c (car a)))))
        (list c b)
    );defun
    
    (defun plineOrg (pt pl / plst norm nb n blst pa d1 d2 d3)
     ;PlineOrg (2.0) -Gilles Chanteau- 15/09/2007 (Modified)
     ;Changes the start point of a closed polyline
     ;pl    :    Entity - A polyline entity in drawing
     ;pt    :    List - Coordinates of the new start point on the polyline
        (if (and
                (setq pl (vlax-ename->vla-object pl))
                (= (vla-get-ObjectName pl) "AcDbPolyline")
                (= (vla-get-Closed pl) :vlax-true)
            );and
            (progn
                (setq    plst    (vlax-get pl 'Coordinates)
                        norm    (vlax-get pl 'Normal)
                        pt        (trans pt 1 0)
                        pa        (vlax-curve-getParamAtPoint pl pt)
                        nb        (/ (length plst) 2)
                        n        nb
                );setq
                (repeat n
                    (setq blst (cons (vla-getBulge pl (setq n (1- n))) blst))
                );repeat
                (if (= pa (fix pa))
                    (setq    n        (fix pa)
                            plst    (append (sublist plst (* 2 n) nil)
                                        (sublist plst 0 (* 2 n))
                                    );append
                            blst    (append (sublist blst n nil) (sublist blst 0 n))
                    );setq
                    (setq    n        (1+ (fix pa))
                            d3        (vlax-curve-getDistAtParam pl n)
                            d2        (- d3 (vlax-curve-getDistAtPoint pl pt))
                            d3        (- d3 (vlax-curve-getDistAtParam pl (1- n)))
                            d1        (- d3 d2)
                            pt        (trans pt 0 (vlax-get pl 'Normal))
                            plst    (append (list (car pt) (cadr pt))
                                        (sublist plst (* 2 n) nil)
                                        (sublist plst 0 (* 2 n))
                                    );append
                            blst    (append (list (k*bulge (nth (1- n) blst) (/ d2 d3)))
                                        (sublist blst n nil)
                                        (sublist blst 0 (1- n))
                                        (list (k*bulge (nth (1- n) blst) (/ d1 d3)))
                                    );append
                    );setq
                );if
                (vlax-put pl 'coordinates plst)
                (repeat (setq n (length blst))
                    (vla-setBulge pl (setq n (1- n)) (nth n blst))
                );repeat
            );progn
            (prompt "\nUnvalid entity.")
        );if
    );defun
    
    (defun sublist (lst start leng / n r)
     ;Returns a sublist of defined position and length from a given list
     ;lst    :    List - Target list
     ;start    :    Int - Start index for the sub-list (first item = 0)
     ;leng    :    Int - Sub-list length (or nil)
     ;Examples:
     ;(sublist '(1 2 3 4 5 6) 2 2) -> (3 4)
     ;(sublist '(1 2 3 4 5 6) 2 nil) -> (3 4 5 6)
        (if (or (not leng) (< (- (length lst) start) leng))
            (setq leng (- (length lst) start))
        );if
        (setq n (+ start leng))
        (repeat leng
            (setq r (cons (nth (setq n (1- n)) lst) r))
        );repeat
    );defun
    
    
    (defun k*bulge (b k / a)
     ;Returns a bulge which is proportional to a reference
     ;Arguments :
     : the reference bulge
     ;k : the ratio (between angles or arcs length)
        (setq a (atan b))
        (/ (sin (* k a)) (cos (* k a)))
    );defun
    
    (defun dist (a b)
     ;Find the distance btween two points
     ;a            :    List - First set of coordinates (x1 y2)
              :    List - Second set of coordinates (x2 y2)
     ;Returns    :    Real - Aligned distance between two points
        (sqrt (+ (expt (- (car a) (car b)) 2) (expt (- (cadr a) (cadr b)) 2)))
    );defun
    
    (defun ang (a b c)
     ;Vector calculus to determine angle from three points, converted from radians to degrees
     ;a            :    List - First set of coordinates (x y)
              :    List - Second set of coordinates (x y), this is the vertex of the angle
     ;c            :    List - Third set of coordinates (x y)
     ;Returns    :    Real - Degrees of the angle
        (defun acos (a)
            (atan (sqrt (- 1 (* a a))) a)
        );defun
        (* 180.0 (/ (acos (/ (- (+ (expt (dist b a) 2) (expt (dist b c) 2)) (expt (dist a c) 2)) (* 2 (dist b a) (dist b c)))) pi))
         ;radians> (acos (/ (- (+ (expt (dist b a) 2) (expt (dist b c) 2)) (expt (dist a c) 2)) (* 2 (dist b a) (dist b c))))
    );defun
    
    (defun distHor (a b)
     ;Find the horizontal distance between two points
     ;a            :    List - First set of coordinates (x y)
              :    List - Second set of coordinates (x y)
     ;Returns    :    Real - Horizontal distance between two points
        (abs (- (car a) (car b)))
    );defun
    
    (defun distVer (a b)
     ;Find the vertical distance between two points
     ;a            :    List - First set of coordinates (x y)
              :    List - Second set of coordinates (x y)
     ;Returns    :    Real - Vertical distance between two points
        (abs (- (cadr a) (cadr b)))
    );defun
    
    (defun getMid (a b)
     ;Find the coordinates of a midpoint between two points
     ;a            :    List - First set of coordinates (x y)
              :    List - Second set of coordinates (x y)
     ;Returns    :    List - Coordinates of the midpoint (x y)
        (list (/ (+ (car a) (car b)) 2) (/ (+ (cadr a) (cadr b)) 2))
    );defun
    
    (defun drawDim (a b ofst side prefix /)
     ;Draws a dimension string from two points
     ;a            :    List - First extension line coordinates (x y)
              :    List - Second extension line coordinates (x y)
     ;ofst        :    List - Bounding box list of coordinates ((x1 y1)(x2 y2))
     ;side        :    String - Side of shape to place dimension. Accepts "left", "bottom", "right" & "top"
     ;prefix    :    String - Prefix for OldCastle Shape required sides. Should be in form: "B=<>". pass nil for no prefix.
        (cond
            ( (= side "left") (setq ofst (list (car (car ofst)) (cadr (getMid a b)))) )
            ( (= side "bottom") (setq ofst (list (car (getMid a b)) (cadr (car ofst)))) )
            ( (= side "right") (setq ofst (list (car (cadr ofst)) (cadr (getMid a b)))) )
            ( (= side "top") (setq ofst (list (car (getMid a b)) (cadr (cadr ofst)))) )
             ;ofst arg when brought in is two points that create a bounding box.
             ;This cond changes ofst var to a list where one value is the appropriate offset
             ;required for the dimension and the other is the mid point (x or y depending) between
             ;points A and B. This ensures that a horizontal dim is not used in place of a vertical or vice versa
        );cond
        (setvar "OSMODE" 0)
        (if (not (null prefix)) (setvar "DIMPOST" prefix))
        (if (not (null prefix)) (setvar "DIMTXSTY" "Arial"))
        (if (or (= side "left") (= side "right"))
            (command "_.DIMLINEAR" a b "angle" "90" ofst)
            (command "_.DIMLINEAR" a b ofst)
        );if
        (setvar "DIMPOST" pre)
        (setvar "DIMTXSTY" style)
    );defun
    
    (defun drawDiam (circle / pt-on-circle pt-for-dim)
     ;Draws a diameter dimension on a specified circle
     ;circle    :    Entity - An entity assignment for a circle in the drawing
        (setq pt-for-dim (list (+ 1 (car (dxfGroup 10 circle))) (+ 1 (cadr (dxfGroup 10 circle)))))
        (setvar "OSMODE" 0)
        (if (= "CIRCLE" (cdr (assoc 0 (entget circle)))) ;is it really a circle?
            (setq pt-on-circle (polar (cdr (assoc 10 (entget circle))) ;get circle's centre point
                (cdr (assoc 40 (entget circle))) ;get circle's radius
                (* pi 0.5)) ;45°
            );setq
        );if
        (command "_.DIMDIAMETER" (list circle pt-on-circle) "_none" pt-for-dim)
         ;just object is not enough, some commands needs both ename and point, combined into list '(ename (10 10 0))
    );defun
    
    ;====ACTUAL PROGRAM BELOW====;
    
    (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    (setvar "CMDECHO" 0)
    (setvar "CLAYER" "Dimensiuni")
    (if (setq entAll (ssget))
        (progn
            (setq    i                0
                    ConturBorder        nil
                    holes            (list)
                    fuzz            1.0e-6
                    ofstTYP            75
            );setq
            (while (< i (sslength entAll))
             ; Iterates through selected entities
                (setq    entCurr    (ssname entAll i)
                        i        (1+ i)
                );setq
                (if
                    (= (dxfGroup 8 entCurr) "Contur")
                     ;Looks for object on layer 'Contur'.
                     ;Only one object should exist on Contur layer per panel
                    (progn
                        (if
                            (= ConturBorder nil)
                            (setq ConturBorder entCurr)
                            (*error* "\nToo many Contur borders selected! Check if your polyline has been joined!")
                             ;throws error if more than one object on Contur layer exists
                        );if
                    );progn
                );if
                (if
                    (= (dxfGroup 0 entCurr) "INSERT")
                     ;if entCurr type = Block
                    (if
                        (= (vla-get-effectivename (vlax-ename->vla-object entCurr)) "ShapeSymbol")
                         ;checks if block name is "ShapeSymbol" and then saves the Tag attribute value to var "shape"
                        (progn
                            (setq entCurr (entnext entCurr))
                            (while (not (eq "SEQEND" (dxfGroup 0 entCurr)))
                             ;"SEQEND" = end of attributes in block
                                (setq entCurr (entnext entCurr))
                                (if (= (dxfGroup 2 entCurr) "Tag") (setq shape (dxfGroup 1 entCurr)))
                            );while
                        );progn
                    );if
                );if
                (if
                    (= (dxfGroup 0 entCurr) "CIRCLE")
                    (if
                        (= (dxfGroup 8 entCurr) "gaurire")
                        (progn
                            (setq holes (cons (list (car (dxfGroup 10 entCurr)) (cadr (dxfGroup 10 entCurr))) holes))
                            (drawDiam entCurr)
                        );progn
                    );if
                );if
            );while
            (if (= ConturBorder nil) (*error* "\nNo Contur border selected! Check your layers. Contur must be on 'Contur' layer."))
             ;throws error if no objects on 'Contur' layer existed in selection set
            (if (/= (dxfGroup 0 ConturBorder) "LWPOLYLINE") (*error* "\nContur border is not a polyline! Check if your Contur has been joined."))
             ;throws error the object on layer 'Contur' is not a polyline
            (if (/= (logand (dxfGroup 70 ConturBorder) 1) 1) (*error* "\nContur polyline is not closed! Check all corners of Contur before dimensioning."))
             ;throws an error if Contur border does not have logical bitwise value of 1, denoting a closed polyline
            (setq ConturBorderPts (getPLPoints (entget ConturBorder)))
            (plineOrg (findBL ConturBorderPts) ConturBorder)
             ;recreates ConturBorder polyline to ensure that the origin is at the bottom left of the shape (Point "A")
             ;this will fail on shapes with no flat bottom
             ;TODO: create exceptions for shape 51, 61, 62, 64, 65, 75.
            (setq ConturBorderPts (getPLPoints (entget ConturBorder)))
            (if
                (>= (cadr (car ConturBorderPts)) (cadr (cadr ConturBorderPts)))
                (progn
                    (command ".pedit" ConturBorder "reverse" "")
                    (plineOrg (findBL ConturBorderPts) ConturBorder)
                    (setq ConturBorderPts (getPLPoints (entget ConturBorder)))
                    (prompt "\nPolyline is backwards. Reversing")
                );progn
            );if
             ;checks if polyline is drawn clockwise from origin by checking if point B is greater than point A
            (setq bounding (MkBoundingBox ConturBorderPts))
            (setq bounding (growBound bounding "all" 0))
            (setq i 0
                j 0)
            (foreach j ConturBorderPts
                (cond
                    ;( (= i 0) (progn (setq A j) (command "-TEXT" A "1.5" "0" "A")) )
                    ;( (= i 1) (progn (setq B j) (command "-TEXT" B "1.5" "0" "B")) )
                    ;( (= i 2) (progn (setq C j) (command "-TEXT" C "1.5" "0" "C")) )
                    ;( (= i 3) (progn (setq D j) (command "-TEXT" D "1.5" "0" "D")) )
                    ;( (= i 4) (progn (setq E j) (command "-TEXT" E "1.5" "0" "E")) )
                    ;( (= i 5) (progn (setq F j) (command "-TEXT" F "1.5" "0" "F")) )
                    ;( (= i 6) (progn (setq G j) (command "-TEXT" G "1.5" "0" "G")) )
                    ;( (= i 7) (progn (setq H j) (command "-TEXT" H "1.5" "0" "H")) )
                    ( (= i 0) (setq A j) )
                    ( (= i 1) (setq B j) )
                    ( (= i 2) (setq C j) )
                    ( (= i 3) (setq D j) )
                    ( (= i 4) (setq E j) )
                    ( (= i 5) (setq F j) )
                    ( (= i 6) (setq G j) )
                    ( (= i 7) (setq H j) )
                );cond
                (setq i (1+ i))
            );foreach

            (if holes (progn
                        (setq holes    (orgCoords holes "LB")
                              i     0
                        );setq
                        (foreach j holes
                            (setq i (1+ i))
                            (if (not (equal (car j) (car (nth i holes))))
                                (progn
                                    (drawDim a j bounding "bottom" nil)
                                    (setq bounding (growBound bounding "bottom" 0))
                                );progn
                            );if
                        );foreach
                        (setq holes    (orgCoords holes "BL")
                              i        0
                        );setq
                        (foreach j holes
                            (setq i (1+ i))
                            (if (not (equal (cadr j) (cadr (nth i holes))))
                                (progn
                                    (drawDim a j bounding "left" nil)
                                    (setq bounding (growBound bounding "left" 0))
                                );progn
                            );if
                        );foreach
                    ));progn;if
                    ;(if holes
                    ;    (progn
                    ;        (setq    holes    (orgCoords holes "LB")
                    ;                i        0
                    ;                k        0)
                    ;        (foreach j holes
                    ;            (setq i (1+ i))
                    ;            (cond
                    ;                ( (and (equal (nearCor j) a fuzz) (not (equal (car j) (car (nth i holes)))))
                    ;                  (setq k (1+ k))
                    ;                  (drawDim j a (growBound bounding "bottom" (* ofstTYP k)) "bottom" nil)
                    ;                  
                    ;                )
                    ;            );cond
                    ;        );foreach
                    ;    );progn
                    ;);if
                    (drawDim a d bounding "bottom" "B=<>")
                    (drawDim a b bounding "left" "L=<>")
                )
            );cond
        );progn
        (print "Invalid selection!")
    );if
    (*error* nil)
    (princ)
);defun