Attempting to write a "Torient" routine - needs debugging...

[dlbsurveysuk]

Hi,

I'm attempting to write a text rotation routine (idea is replace "TORIENT" so that I can call the command in other routines) -

Select all text

Repeat through list

Check if upside down (radians to degrees of text rotation + rotation of UCS from WCS)

Use "textbox" to rotate 180...

it breaks here and I don't know why, any help appreciated -

(+ (RTD rotang) (ROTATION))

Full routine (probably multiple errors but haven't progressed beyond the above error).

(defun c:UPDN (/ corth sstxt num rotang angr ptxt tbox pnt1 pnt2 pnt3)

(setq corth (getvar "orthomode"))

(setq sstxt (ssget "_A" '((0 . "text")))
      num -1)

      (repeat (sslength sstxt)

           (setq rotang (cdr (assoc 50 (entget (ssname sstxt (setq num (1+ num)))))))
           (setq angr (+ (RTD rotang) (ROTATION)))
	
                    (if (and (> 90 angr) (< 270 angr))

                          (progn

                              (setq ptxt (entget (car (sstxt ssname num))))

                              (command "UCS" "entity" ptxt)
                                    (setq tbox (textbox (list (car ptxt)))
                                             pnt1 (car tbox)
                                             pnt2 (cadr tbox)
                                             pnt3 (polar pnt1 (angle pnt1 pnt2) (* 0.5 (distance pnt1 pnt2)
                                     )))
                              (setvar "orthomode" 1)

                              (command "ROTATE" ptxt "" pnt3 180)
			    
                              (setvar "orthomode" corth)
                              (command "UCS" "p")

                           );progn
                    );if
       );repeat

(princ)
)

;*****************RADIANS-TO-DEGREES******************

(defun RTD (a) (* 180.0 (/ a pi)))

;************ROTATION-OF-UCS-FROM-WCS*************

(defun ROTATION (/ p1w p2w ang)

   (setq p1w (trans '(0 0 0) 1 0)
         p2w (trans '(10 0 0) 1 0)
         ang (rtd (angle p1w p2w))
   )
   ang

 (princ)
 )

;**************************************************************

[Kent1Cooper]

What does "it breaks" mean?  Are there any messages?  Does it do nothing, or something you don't intend, and if the latter, what?  Etc., etc.

[ВeekeeCZ]

(defun ROTATION (/ p1w p2w ang)
  
  (setq p1w (trans '(0 0 0) 1 0)
	p2w (trans '(10 0 0) 1 0)
	ang (rtd (angle p1w p2w))
	)
  ang
  
  (princ)
  )

[dlbsurveysuk]

OK. I've removed the "(princ)" from the ROTATION routine. Now there is no Last Break Source. It appears to run but nothing changes on my test drawing...

These are last values (can't seem to copy and paste) -

[ВeekeeCZ]

You know what, you need to trace it line by line... 

btw Are you sure that you will EVER have a text in angle a that is a<90 AND! a>270 ??

[dlbsurveysuk]

OK yes, I think I'm making a conceptual error regarding the angle of upside down text. Need to think more about that...

[dlbsurveysuk]

OK. I've realised that I've been a bit simple minded in conceptualising the problem. The idea was to rotate a drawing by any random amount and set a UCS. Some of the text will then be upside down. Selecting the upside down text is not as easy as I first thought... (I've basically given up).

Anyway, I've found the c:torient file and associated sub-routines in my AutoCad installation. I've copied and renamed, edited some of the code to auto select and auto default to "Most Readable". I can now call this routine in other Lisp code and it will execute with no user input required, which is what I was after.

The thing is that this code is copyrighted/restricted by Autodesk. Does this mean that what I have done is illegal?

[ВeekeeCZ]

Working with angles is somewhat tricky and the fact that TEXT angle is stored in WCS (logically), but MTEXT in UCS (wtf!) does not help either. But at some point, you'll find it necessary to dive into it.
The use of ET subfunction is offered, but it could be tricky to edit - quite complex routines with plenty of references to other subs. As for (c), don't post it (at least not the entire code), and don't sell it.

[komondormrex]

hey,

are going to rotate mtexts only?

[dlbsurveysuk]

Yeah, texts only (not mtext and not text on locked layers). It's generally for level text.

[komondormrex · Accepted solution]

well, it is not the correction to your code nor it is a modification of the quarter of century old autodesk program. it is rather one new. done as a function with two parameters. 1st is the angle in degrees to rotate selection set of text entities, which is actually the second parameter. if first parameter passed as nil, the function will rotate each text ename of selection set of texts to be best readable. either rotation will be done accordingly to usc set. 

you should call the function like this (_torient nil sset) or (_torient 45 sset) or (_torient nil (ssget)),

where sset is some selection set, which may hold any enames along with texts.

uses the et acet-geom-textbox function for getting bounding box of each text ename.

;*********************************************************************************************************

;	komondormrex, jan 2024

;*********************************************************************************************************

(defun vector_multiplying (vector_1 vector_2 / x1 y1 z1 x2 y2 z2)
  (mapcar 'set '(x1 y1 z1) vector_1)
  (mapcar 'set '(x2 y2 z2) vector_2)
    (list (- (* y1 z2) (* z1 y2))
          (- (* z1 x2) (* x1 z2))
          (- (* x1 y2) (* y1 x2))
    )
)

;*********************************************************************************************************

(defun _torient (angle_degrees sset / ucsxdir_angle text_object text_bb text_rotation)
  (setq ucsxdir_angle (angle '(0 0) (getvar 'ucsxdir)) skipped 0 processed 0)
  (if sset
    (foreach text (vl-remove-if-not '(lambda (ename) (= "TEXT" (cdr (assoc 0 (entget ename)))))
                     (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))
            )
      (if (and
          (equal '(0 0 1) (vector_multiplying (getvar 'ucsxdir) (getvar 'ucsydir)) 1e-8)
          (equal '(0 0 1) (cdr (assoc 210 (entget text))) 1e-8)
          (setq text_rotation (vla-get-rotation (setq text_object (vlax-ename->vla-object text))))
        )
          (progn
            (vla-rotate text_object
                  (vlax-3d-point (trans (mapcar '+ (car (setq text_bb (acet-geom-textbox (entget text) 0)))
                                        (mapcar '* '(0.5 0.5) (mapcar '- (caddr text_bb) (car text_bb)))
                              ) 1 0
                           )
                  )
                  (if (null angle_degrees)
                    (if (and (< (* 0.5 pi)
                             (setq text_ucs_rotation (if (minusp (- text_rotation ucsxdir_angle))
                                             (+ pi pi (- text_rotation ucsxdir_angle))
                                             (- text_rotation ucsxdir_angle)
                                            )
                             )
                         )
                         (<= text_ucs_rotation (* 1.5 pi))
                      )
                      pi 0
                      )
                    (+ ucsxdir_angle (- (/ (* pi angle_degrees) 180) text_rotation))
                  )
            )
            (princ (strcat "\rProcessed: " (itoa (setq processed (1+ processed))) ", Skipped: " (itoa skipped)))
          )
          (princ (strcat "\rRotated: " (itoa processed) ", Skipped: " (itoa (setq skipped (1+ skipped)))))
      )
    )
  )
  (princ)
)

;*********************************************************************************************************

[dlbsurveysuk]

Fantastic! Works perfectly and so compact and efficient as compared to the original torient routine.

I'm making an effort to understand how it works...

One thing is - it shows the number processed and the number skipped in the command line, but it doesn't show the number it actually rotated. I'm having difficulty seeing exactly where or how to add the rotated entities to a selection set (and maybe highlight the actually rotated entities with (sssetfirst nil SS).

Thanks very much, I'm gonna use this instead of my cannibalised version.