Need help editing LISP routine to rotate attributes to readable angle

[amb9003]

Hi Friends,
i have lisp, which rotates the attributes as per the block angle...but there is an issue on that....
as per the attached screenshot, for some block angles, attributes are not in readable angle...
could someone help me to edit the lisp, so as to get attributes aligned in readable angles.

attached sample drawing & screenshots.

(vl-load-com)
(defun c:test ( / oldang oldunit oldsnap obj ang ins Tp xscale bname ins)
(setq oldang (getvar 'angdir))
(setq oldunit (getvar 'aunits))
(setq oldsnap (getvar 'osmode))
(setvar 'angdir 0)
(setvar 'aunits 3)
(setvar 'osmode 0)

(setq obj (vlax-ename->vla-object (car (entsel "\nPick Block object"))))
(setq Objname (vla-get-Objectname obj))
(if (/= Objname "AcDbBlockReference") ; check is it a block
(alert "You have not Picked a block\n\nPress ok ")
(progn
(setq ang (vla-get-rotation obj))
(setq ins (vlax-safearray->list (vlax-variant-value(vla-get-insertionpoint 

obj))))
(setq xscale (vla-get-XScaleFactor obj))
(setq bname (vla-get-name obj))

(cond
((if (= bname "TERMINAL")(setq len 4.5))) ; as per sample 
((if (= bname "xxxx")(setq len 5))) ; other blocks change len value
)
(setq off 6.0)
(setq off1 8.0)

(setq Tp  (vlax-ename->vla-object (car  (entsel "\nPick text1"))))
(setq pt1 (vlax-3d-point  (polar ins (+ ang (/ 0.25)) off1)))
(vla-put-insertionpoint Tp  pt1)
(vla-put-rotation Tp ang )

(setq Tp  (vlax-ename->vla-object (car  (entsel "\nPick text2"))))
(setq pt1 (vlax-3d-point  (polar ins (+ ang (/ 0.2)) off1)))
(vla-put-insertionpoint Tp  pt1)
(vla-put-rotation Tp ang )

(setq Tp  (vlax-ename->vla-object (car  (entsel "\nPick text3"))))
(setq pt1 (vlax-3d-point  (polar ins ang (* len 1.7))))
(vla-put-insertionpoint Tp  pt1)
(vla-put-rotation Tp ang )

(setvar 'angdir oldang)
(setvar 'aunits oldunit)
(setvar 'osmode oldsnap)
)
)
)

Thanks in Advance.

[Tom Beauford]

See also:
https://forums.augi.com/showthread.p...42#post1347242

- - - Updated - - -

See also: https://forums.augi.com/showthread.p...71#post1347271

[amb9003]

See also:
https://forums.augi.com/showthread.p...42#post1347242

- - - Updated - - -

See also: https://forums.augi.com/showthread.p...71#post1347271

Hi Tom Beauford,

the links are same, which i posted earlier & that issue got resolved already...
do you want me to continue the query on that earlier post itself ....could you please explain

[dlanor]

I still cannot open your drawing

This adjustment to your lisp should work. Once each text is rotated it is passed to the (rh:rta) sub-routine. This tests if the rotation is between 90 and 270. If it is, it finds the midpoint of the text bounding box and rotates it 180 degrees. This should work for "TEXT" items only. If you are using "MTEXT" it will need expanding as the bounding box of "MTEXT" is based on the width property not the objects extents.

(defun rh:rta (obj / a ll ur lst cpt)
  (setq a (vlax-get obj 'rotation))
  (cond ( (< (* pi 0.5) a (* pi 1.5))
          (vlax-invoke-method obj 'getboundingbox 'll 'ur)
          (setq lst (mapcar 'vlax-safearray->list (list ll ur))
                cpt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car lst) (cadr lst))
          )
          (vlax-invoke obj 'rotate cpt pi)
        )
  );end_cond
);end_defun


(vl-load-com)

(defun c:test ( / oldang oldunit oldsnap obj ang ins Tp xscale bname ins)
  (setq oldang (getvar 'angdir))
  (setq oldunit (getvar 'aunits))
  (setq oldsnap (getvar 'osmode))
  (setvar 'angdir 0)
  (setvar 'aunits 3)
  (setvar 'osmode 0)

  (setq obj (vlax-ename->vla-object (car (entsel "\nPick Block object"))))
  (setq Objname (vla-get-Objectname obj))
  (if (/= Objname "AcDbBlockReference") ; check is it a block
    (alert "You have not Picked a block\n\nPress ok ")
    (progn
      (setq ang (vla-get-rotation obj))
      (setq ins (vlax-safearray->list (vlax-variant-value(vla-get-insertionpoint obj))))
      (setq xscale (vla-get-XScaleFactor obj))
      (setq bname (vla-get-name obj))

      (cond
      ((if (= bname "TERMINAL")(setq len 4.5))) ; as per sample 
      ((if (= bname "xxxx")(setq len 5))) ; other blocks change len value
      )
      (setq off 6.0)
      (setq off1 8.0)

      (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text1"))))
      (setq pt1 (vlax-3d-point (polar ins (+ ang (/ 0.25)) off1)))
      (vla-put-insertionpoint Tp pt1)
      (vla-put-rotation Tp ang )
      (rh:rta Tp)

      (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text2"))))
      (setq pt1 (vlax-3d-point (polar ins (+ ang (/ 0.2)) off1)))
      (vla-put-insertionpoint Tp pt1)
      (vla-put-rotation Tp ang )
      (rh:rta Tp)

      (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text3"))))
      (setq pt1 (vlax-3d-point (polar ins ang (* len 1.7))))
      (vla-put-insertionpoint Tp pt1)
      (vla-put-rotation Tp ang )
      (rh:rta Tp)

      (setvar 'angdir oldang)
      (setvar 'aunits oldunit)
      (setvar 'osmode oldsnap)
    )
  )
)

[amb9003]

Hi dlanor,
Thank you so much for looking on my post & sorry for uploading again a latest version dwg, now i have converted to older version & uploaded,
Thank you so much for your code, it almost worked .... its now going in proper readable angle but the arrangements are getting upside down,
i have attached the screenshot, which shows the issues.
could you please look on to it.

Thanks in Advance.

[dlanor]

OK, drawing opens and I can see whats what. Should have something in a couple of hours.

[dlanor]

OK try this modified version

;; based on ssboundingbox by Lee Mac
;; boundingbox of a lst of objects
(defun bblst ( lst / ll ur lllst urlst)
  (foreach obj lst
    (if (and (vlax-method-applicable-p obj 'getboundingbox)
             (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'll 'ur))))
        )
      (setq lllst (cons (vlax-safearray->list ll) lllst) urlst (cons (vlax-safearray->list ur) urlst))
    )
  )
  (if (and lllst urlst) (mapcar '(lambda ( x y ) (apply 'mapcar (cons x y))) '(min max) (list lllst urlst)))
)

(defun rh:rta (lst a / rlst cpt)
  (cond ( (< (* pi 0.5) a (* pi 1.5))
          (vlax-invoke-method obj 'getboundingbox 'll 'ur)
          (setq rlst (rh:bblst lst)
                cpt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car rlst) (cadr rlst))
          )
          (foreach o lst (vlax-invoke o 'rotate cpt pi))
        )
  );end_cond
);end_defun


(vl-load-com)

(defun c:test ( / oldang oldunit oldsnap obj ang ins olst Tp xscale bname ins)
  (setq oldang (getvar 'angdir))
  (setq oldunit (getvar 'aunits))
  (setq oldsnap (getvar 'osmode))
  (setvar 'angdir 0)
  (setvar 'aunits 3)
  (setvar 'osmode 0)

  (setq obj (vlax-ename->vla-object (car (entsel "\nPick Block object"))))
  (setq Objname (vla-get-Objectname obj))
  (if (/= Objname "AcDbBlockReference") ; check is it a block
    (alert "You have not Picked a block\n\nPress ok ")
    (progn
      (setq ang (vla-get-rotation obj))
      (setq ins (vlax-safearray->list (vlax-variant-value(vla-get-insertionpoint obj))))
      (setq xscale (vla-get-XScaleFactor obj))
      (setq bname (vla-get-name obj))

      (cond
      ((if (= bname "TERMINAL")(setq len 4.5))) ; as per sample 
      ((if (= bname "xxxx")(setq len 5))) ; other blocks change len value
      )
      (setq off 6.0)
      (setq off1 8.0)

      (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text1"))))
      (setq pt1 (vlax-3d-point (polar ins (+ ang (/ 0.25)) off1)))
      (vla-put-insertionpoint Tp pt1)
      (vla-put-rotation Tp ang )
      (setq olst (cons tp olst))

      (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text2"))))
      (setq pt1 (vlax-3d-point (polar ins (+ ang (/ 0.2)) off1)))
      (vla-put-insertionpoint Tp pt1)
      (vla-put-rotation Tp ang )
      (setq olst (cons tp olst))

      (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text3"))))
      (setq pt1 (vlax-3d-point (polar ins ang (* len 1.7))))
      (vla-put-insertionpoint Tp pt1)
      (vla-put-rotation Tp ang )
      (setq olst (cons tp olst))

      (rh:rta olst ang)

      (setvar 'angdir oldang)
      (setvar 'aunits oldunit)
      (setvar 'osmode oldsnap)
    )
  )
)

[Opie]

Is that making the text plan readable?

[amb9003]

Hi dlanor,
i have loaded your updated lisp & run the command "test" , but still its the same ...its not going to readable able....shown the same in screenshot
Thanks for looking on it

[dlanor]

Apologies, I changed a sub-routine name, but forgot to rename the line calling it.

;; based on ssboundingbox by Lee Mac
;; boundingbox of a lst of objects
(defun bblst ( lst / ll ur lllst urlst)
  (foreach obj lst
    (if (and (vlax-method-applicable-p obj 'getboundingbox)
             (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'll 'ur))))
        )
      (setq lllst (cons (vlax-safearray->list ll) lllst) urlst (cons (vlax-safearray->list ur) urlst))
    )
  )
  (if (and lllst urlst) (mapcar '(lambda ( x y ) (apply 'mapcar (cons x y))) '(min max) (list lllst urlst)))
)

(defun rh:rta (lst a / rlst cpt)
  (cond ( (< (* pi 0.5) a (* pi 1.5))
          (vlax-invoke-method obj 'getboundingbox 'll 'ur)
          (setq rlst (bblst lst)
                cpt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car rlst) (cadr rlst))
          )
          (foreach o lst (vlax-invoke o 'rotate cpt pi))
        )
  );end_cond
);end_defun


(vl-load-com)

(defun c:test ( / oldang oldunit oldsnap obj ang ins olst Tp xscale bname ins)
  (setq oldang (getvar 'angdir))
  (setq oldunit (getvar 'aunits))
  (setq oldsnap (getvar 'osmode))
  (setvar 'angdir 0)
  (setvar 'aunits 3)
  (setvar 'osmode 0)

  (setq obj (vlax-ename->vla-object (car (entsel "\nPick Block object"))))
  (setq Objname (vla-get-Objectname obj))
  (if (/= Objname "AcDbBlockReference") ; check is it a block
    (alert "You have not Picked a block\n\nPress ok ")
    (progn
      (setq ang (vla-get-rotation obj))
      (setq ins (vlax-safearray->list (vlax-variant-value(vla-get-insertionpoint obj))))
      (setq xscale (vla-get-XScaleFactor obj))
      (setq bname (vla-get-name obj))

      (cond
      ((if (= bname "TERMINAL")(setq len 4.5))) ; as per sample 
      ((if (= bname "xxxx")(setq len 5))) ; other blocks change len value
      )
      (setq off 6.0)
      (setq off1 8.0)

      (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text1"))))
      (setq pt1 (vlax-3d-point (polar ins (+ ang (/ 0.25)) off1)))
      (vla-put-insertionpoint Tp pt1)
      (vla-put-rotation Tp ang )
      (setq olst (cons tp olst))

      (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text2"))))
      (setq pt1 (vlax-3d-point (polar ins (+ ang (/ 0.2)) off1)))
      (vla-put-insertionpoint Tp pt1)
      (vla-put-rotation Tp ang )
      (setq olst (cons tp olst))

      (setq Tp (vlax-ename->vla-object (car (entsel "\nPick text3"))))
      (setq pt1 (vlax-3d-point (polar ins ang (* len 1.7))))
      (vla-put-insertionpoint Tp pt1)
      (vla-put-rotation Tp ang )
      (setq olst (cons tp olst))

      (rh:rta olst ang)

      (setvar 'angdir oldang)
      (setvar 'aunits oldunit)
      (setvar 'osmode oldsnap)
    )
  )
)

Select the texts in the order you want them to appear (top to bottom) Each text will be spaced then all texts rotated.