[Lisp] Minimum bounding box for rotated attribute/block

I have big problem, with getting minimum bounding box of an attribute.

There is no problem if block and/or atribute are not rotated, but when we have rotation I don't know what to do.

I need this lisp to sort block attributes location based on location of one of block attribute.

Any ideas?

Function should work like Lee Mac LM:minboundingbox

I tried to modify this function but I get error in line 15

(setq lst (cons (vla-copy obj) lst))

Can you post sample file with your current code being used?

You can download example file.

---EDIT

Example of code (with my modication of Lee Mac Minimum Bounding Box, modification allow to use LM:minboundingbox with ename)

;; Minimum Bounding Box  -  Lee Mac
;; Returns the WCS coordinates describing the minimum bounding rectangle
;; surrounding all objects in a supplied selection set.
;; sel - [sel] selection set to process
;; tol - [rea] precision of calculation, 0 < tol < 1

(defun LM:minboundingbox ( sel tol /  ang box bx1 bx2 cen idx lst obj rtn )
	(if (and sel (< 0.0 tol 1.0))
       (progn
;my modification starts here
	(if (eq (type sel) 'ENAME)
		(setq sel (ssadd sel (ssadd)))
	)
;my modification ends here
					(repeat (setq idx (sslength sel))
               (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
               (if (and (vlax-method-applicable-p obj 'getboundingbox)
                        (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
                   )
                   (setq lst (cons (vla-copy obj) lst))
               )
					)
           (if lst
               (progn
                   (setq box (LM:objlstboundingbox lst)
                         tol (* tol pi)
                         cen (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
                         bx1 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                         rtn (list 0.0 box)
                         ang 0.0
                   )
                   (while (< (setq ang (+ ang tol)) pi)
                       (foreach obj lst (vlax-invoke obj 'rotate cen tol))
                       (setq box (LM:objlstboundingbox lst)
                             bx2 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                       )
                       (if (< bx2 bx1)
                           (setq bx1 bx2
                                 rtn (list ang box)
                           )
                       )
                   )
                   (foreach obj lst (vla-delete obj))
                   (LM:rotatepoints
                       (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) (apply b (cdr rtn))) a))
                          '(
                               (caar   cadar)
                               (caadr  cadar)
                               (caadr cadadr)
                               (caar  cadadr)
                           )
                       )
                       cen (- (car rtn))
                   )
               )
           )
       )
   )
)

;; Object List Bounding Box  -  Lee Mac
;; Returns the lower-left and upper-right points of a rectangle bounding a list of objects

(defun LM:objlstboundingbox ( lst / llp ls1 ls2 urp )
   (foreach obj lst
       (vla-getboundingbox obj 'llp 'urp)
       (setq ls1 (cons (vlax-safearray->list llp) ls1)
             ls2 (cons (vlax-safearray->list urp) ls2)
       )
   )
   (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)

;; Rotate Points  -  Lee Mac
;; Rotates a list of points about a supplied point by a given angle

(defun LM:rotatepoints ( lst bpt ang / mat vec )
   (setq mat
       (list
           (list (cos ang) (sin (- ang)) 0.0)
           (list (sin ang) (cos ang)     0.0)
          '(0.0 0.0 1.0)
       )
   )
   (setq vec (mapcar '- bpt (mxv mat bpt)))
   (mapcar '(lambda ( x ) (mapcar '+ (mxv mat x) vec)) lst)
)

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
   (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

Example of use

(defun c:testa3 ( / sel )
	(if (setq sel (car (nentsel)))
       (entmake
           (append
              '(
                   (000 . "LWPOLYLINE")
                   (100 . "AcDbEntity")
                   (100 . "AcDbPolyline")
                   (090 . 4)
                   (070 . 1)
               )
               (mapcar '(lambda ( p ) (cons 10 p)) (LM:minboundingbox sel 0.01))
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

test_file.dwg

I can't reproduce the reported error (Note: I use BricsCAD). But IMO it would make more sense to use the textbox function here.

Something along these lines:

; (alignAtts (car (nentsel)) (car (nentsel)))
(defun alignAtts (enmA enmB / box elstA elstB)
 (setq elstA (entget enmA))
 (setq elstB (entget enmB))
 (setq box (textbox elstA))
 (setq elstB
   (subst
     (cons
       10
       (polar
         (cdr (assoc 10 elstA))
         (cdr (assoc 50 elstA))
         (caadr box)
       )
     )
     (assoc 10 elstB)
     elstB
   )
 )
 (setq elstB
   (subst
     (assoc 50 elstA)
     (assoc 50 elstB)
     elstB
   )
 )
 (entmod elstB)
)

I can't reproduce the reported error (Note: I use BricsCAD). But IMO it would make more sense to use the textbox function here.

Something along these lines:

; (alignAtts (car (nentsel)) (car (nentsel)))
(defun alignAtts (enmA enmB / box elstA elstB)
 (setq elstA (entget enmA))
 (setq elstB (entget enmB))
 (setq box (textbox elstA))
 (setq elstB
   (subst
     (cons
       10
       (polar
         (cdr (assoc 10 elstA))
         (cdr (assoc 50 elstA))
         (caadr box)
       )
     )
     (assoc 10 elstB)
     elstB
   )
 )
 (setq elstB
   (subst
     (assoc 50 elstA)
     (assoc 50 elstB)
     elstB
   )
 )
 (entmod elstB)
)

It works,

I will modify your lisp and tomorrow i will post final code.

Final code

;;ziele_o2k
;;v20160615-1216
(defun c:final ( / *error* ss in blkent attentlst Att-0 Att-1 Att-2 box os)
 (defun *error* (msg / so)
   (cond 
     ((not msg))
     ((member msg '("Function cancelled" "quit / exit abort")))
     (
       (princ (strcat "\n  <!>  Error: " msg "  <!> "))
       (cond (T (vl-bt)))
     )
   )  
   (princ)
 )
 (if(setq ss (ssget '((0 . "INSERT") (2 . "GT-SP-TYP2") (66 . 1))))
   (progn
     (repeat (setq in (sslength ss))
       (setq blkent (ssname ss (setq in (1- in))))
       (setq attentlst (cd:BLK_GetAttEntity blkent))
       (foreach %1 attentlst
         (
           (lambda (%2)
             (cond
               ((eq (cdr (assoc 2 (entget %2))) "NUMBER") (setq Att-0 (entget %2)))
               ((eq (cdr (assoc 2 (entget %2))) "SEPARATOR") (setq Att-1 (entget %2)))
               ((eq (cdr (assoc 2 (entget %2))) "LEVEL") (setq Att-2 (entget %2)))
             )
           )
           %1
         )
       )
       (if (and Att-0 Att-1 Att-2)
         (progn
           (setq box (textbox Att-0))
           (setq os (/ (cdr (assoc 40 Att-1)) )
           (setq  
             Att-1
             (subst
               (cons  
                 10
                 (polar
                   (cdr (assoc 10 Att-0))
                   (cdr (assoc 50 Att-0))
                   (+ (caadr box) os)
                 )
               )
               (assoc 10 Att-1)
               Att-1
             )
             Att-1 (subst (assoc 50 Att-0)(assoc 50 Att-1)Att-1)
           )
           (entmod Att-1)
           (setq box (textbox Att-1))
           (setq
             Att-2
             (subst
               (cons  10
                 (polar
                   (cdr (assoc 10 Att-1))
                   (cdr (assoc 50 Att-1))
                   (+ (caadr box) os)
                 )
               )
               (assoc 10 Att-2)
               Att-2
             )
             Att-2 (subst (assoc 50 Att-1)(assoc 50 Att-2)Att-2)
           )
           (entmod Att-2)
           (entupd blkent)
         )
         (princ "\nNo atts.")
       )
     )
   )
 )
)

There is still problem when we have spaces in begining or end of attribute string. Textbox function ignores that spaces.

But this problem is my future problem.

There is still problem when we have spaces in begining or end of attribute string. Textbox function ignores that spaces.

But this problem is my future problem.

I found this post.

Just idea, first count spaces at begining and end of string.

Next step, add at end of string "AA" get length of text with textbox function,

Then remove "AA" and add "A A" at end, get length with textbox.

Calculate distance of space char.

Add this distance multiplied by number of spaces in begining and end of string to (caadr (textbox SourceStr)).

What do you think about that?

@ ziele_o2k:

That should work.

Note: As the post you refer to already demonstrates, the textbox function will also work with partial, 'dummy', entity lists. So there is no need to change entities for this. And, assuming all attributes with the same tag have the same style and height, you would only have to determine the width of the space character once for every tag.

@ ziele_o2k:

That should work.

Note: As the post you refer to already demonstrates, the textbox function will also work with partial, 'dummy', entity lists. So there is no need to change entities for this. And, assuming all attributes with the same tag have the same style and height, you would only have to determine the width of the space character once for every tag.

Unfortunettly It has to be done for every single tag. Text style is the same, but there are diferences in text height.

... Are you saying that there is no relation between the text height and the width of the space character?

My proposition for textbox function without ignoring spaces at begining and end of string.

;;ziele_o2k
;;20160615-1622
;;elist - An entity definition list defining a text object, in the format returned by entget.
;     (textbox (entget (car (entsel))))
;     (PZ:TextBox (entget (car (entsel))))
(defun PZ:TextBox ( elist / str in SpaceCount SpaceLength)
 (setq 
   str (cdr (assoc 1 elist))
   in 0
   SpaceCount 0
 )
 ;Count Spaces at begining of string
 (while (eq (nth in (vl-string->list str)) 32)
   (setq 
     SpaceCount (1+ SpaceCount)
     in (1+ in)
   )
 )
 ;Count Spaces at end of string
 (setq in 0)
 (while (eq (nth in (reverse (vl-string->list str))) 32)
   (setq 
     SpaceCount (1+ SpaceCount)
     in (1+ in)
   )
 )
 ;Calculate space length
 (setq 
   SpaceLength
   (-
     ;String with space
     (caadr
       (textbox 
         (entmod
           (subst 
               (cons 1 "A A")
               (assoc 1 elist)
               elist
           )
         )
       )
     )
     ;String without space
     (caadr
       (textbox 
         (entmod
           (subst 
               (cons 1 "AA")
               (assoc 1 elist)
               elist
           )
         )
       )
     )
   )
 )
 ;Restore string value to default
 (entmod
  (subst 
     (cons 1 str)
     (assoc 1 elist)
     elist
   )
 )
 ;return list with textbox coordinates
 (list 
   (car (textbox elist))
   (list 
     (+ (caadr (textbox elist)) (* SpaceLength SpaceCount))
     (cadr (cadr (textbox elist)))
     (caddr (cadr (textbox elist)))
   )
 )
)

My proposition for textbox function without ignoring spaces at begining and end of string.

Final version (I hope)

; =========================================================================================== ;
;  DATA  [list] - An entity definition list defining a text object,                           ;
;                 in the format returned by entget                                            ;
;  Mode [T/nil] - nil = standard textbox function procedure                                   ;
;                       (ignore spaces at start and end of string)                            ;
;                 T   = extended textbox function                                             ;
;                       (do not ignore spaces at start and end of string)                     ;
; =========================================================================================== ;
(defun TextBoxExt (Data Mode / _SpacesI _SpaceLen s i e r)
 (setq s (cdr (assoc 1 Data)) r (textbox Data))
 (defun _SpacesI (s / l)
   (- 
     (strlen s)
     (strlen (vl-string-trim " " s))
   )
 )
 (defun _SpaceLen (d)
   (-
     (caadr (textbox (subst (cons 1 "A A")(assoc 1 d) d)))
     (caadr (textbox (subst (cons 1 "AA")(assoc 1 d) d)))
   )
 )
 (if Mode
   (if
     (wcmatch s " *,* ")
     (progn
       (setq i (_SpacesI s) e (_SpaceLen Data))
       (list
         (car r)
         (list 
           (+ (caadr r) (* e i))
           (cadr (cadr r))
           (caddr (cadr r))
         )
       )
     )
     r
   )
   r
 )
)

---Edit

Lee Mac version