Color Analysis by Text rotation parameter

Anonymous

Color Analysis by Text rotation parameter

Anonymous
Not applicable

I am none programmer and but I willing to find the answer is this possible  with AutoLISP to give a color for text by its own rotation parameter. I have been trying to make it without script with quick selection and selection filter tools but they have failed on angles from 0 to -180 deg.. Only data extraction can show correct angles. AutoLISP can find Text rotation angle but values are radians so  I need convert units to deg.I have found a lot info on internet but about AutoLISP functions IF and cons, but for me its to advanced level. Most important thing in this process color range with if function =>0 and =<44 assign color 3, =>45 and =<89 assign color 4, =>90 and =<134 assign color 5 etc. till 360 deg. Autodesk have a lot 3d analysis tools and none for 2D only handCAD ๐Ÿ™‚ 

0 Likes
Reply
Accepted solutions (1)
1,345 Views
15 Replies
Replies (15)

john.uhden
Mentor
Mentor

It's interesting that you have angle 0 pointing to the left.  I think most of us have it pointing to the right with angles increasing counterclockwise.  These are governed by the drawing variables ANGBASE and ANGDIR.

 

I have never filtered text selection by rotation angle, but I'm pretty sure it can be done.

 

I'll bet you 10-1 that @ะ’eekeeCZ will post the complete code before I have finished typing this sentence.

John F. Uhden

john.uhden
Mentor
Mentor

Yes, we can filter text selection by a range of rotation angles.

John F. Uhden

0 Likes

Anonymous
Not applicable

Yes are right it was Text symbol with opposite direction. Thanks for quick response.

0 Likes

Ranjit_Singh2
Advisor
Advisor
Accepted solution

maybe something like this

(vl-load-com)
(defun c:somefunc  (/ ss1 textrot vlaobj lst1 lst2)
 (setq lst1 '(0 45 90 135 180 225 270 315 360)
       lst2 '(3 4 5 6 7 8 9 10))
 (mapcar '(lambda (a)
           (and (= 'ename (type a))
                (mapcar '(lambda (x y z)
                          (setq textrot (/ (* 180 (vla-get-rotation (setq vlaobj (vlax-ename->vla-object a)))) pi))
                          (if (and (>= textrot x) (< textrot y))
                           (vla-put-color vlaobj z)))
                        lst1
                        (cdr lst1)
                        lst2)))
         (mapcar 'cadr (ssnamex (ssget '((0 . "TEXT,MTEXT"))))))
 (princ))

Anonymous
Not applicable

Super works perfect. Thanks a lot ๐Ÿ™‚

0 Likes

Ranjit_Singh2
Advisor
Advisor

You are welcome ๐Ÿ™‚

0 Likes

Kent1Cooper
Consultant
Consultant

Welcome to these Forums!

 

There's no need to convert the radians to degrees, nor to make lists of angle categories and the colors to go with them.  You can do the whole thing directly in radians, and figure the required color number based simply on dividing the Text's rotation angle by 45 degrees [with compensation for the facts that your first color number is 3, and that you want the 45-degree multiples to be the start of a range, rather than the end of one]:

 

(defun C:TCR (/ ss n tdata trot); = Text Color by Rotation
  (if (setq ss (ssget "_:L" '((0 . "TEXT"))))
    ; User selected Text object(s) [on unlocked Layer(s)]
    (repeat (setq n (sslength ss))
      (setq
        tdata (entget (ssname ss (setq n (1- n))))
        trot (cdr (assoc 50 tdata)); rotation [in radians]
      ); setq
      (entmod
        (append
          tdata
          (list
            (cons 62
              (+ 3 ; [to start first 0-to-<45 category at green]
                (cond
                  ((equal trot 0 1e-4) 0); exactly 0
                  ( (or ; exactly at octant crossover direction
                      (equal (rem trot (/ pi 4)) 0 1e-4)
                      (equal (rem trot (/ pi 4)) (/ pi 4) 1e-4)
                    ); or
                    (1+ (fix (/ trot (/ pi 4)))); [start next color]
                  ); octant-direction condition
                  ((fix (/ trot (/ pi 4)))); all other angles
                ); cond
              ); +
            ); cons
          ); list
            ; will replace earlier 62-code [color] entry if present
        ); append
      ); entmod
    ); repeat
  ); if
  (princ)
); defun

[That (or) test with (rem) functions in it is because sometimes the remainder from dividing a 45-degree-multiple angle by 45 degrees turns out to be essentially 45 degrees [only a few gazillionths less than that], rather than essentially 0, on account of tiny differences many decimal places down in the number as it's stored or calculated.  I have found this kind of accommodation necessary before in determining whether an angle is a multiple of some reference angle.]

 

TextColorDir.PNG

 

Kent Cooper, AIA
0 Likes

john.uhden
Mentor
Mentor

Ranjit's lokks much more compact, but mine has error, undo, and locked layer controls...

 

(defun C:TextRotColor ( / *error* cmd Doc ss i e ent ranges dtor @addstr
              @check_locked)
  ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  ;*                                                                           *
  ;*         TextRotColor.LSP   by   John F. Uhden                                   *
  ;*                           2 Village Road                                  *
  ;*                           Sea Girt, NJ  08750                             *
  ;*                                                                           *
  ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * *

  ;; Program changes the color of text entities based on their rotation angle from zero.
  (gc)
  (vl-load-com)
  (prompt "\nTextRotColor v1.00 (c)2017, John F. Uhden")
  (princ)
  ;;
  ;; This section initializes environmental and program variables:
  ;;
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (setq cmd (getvar "cmdecho")
        Doc (vla-get-ActiveDocument *acad*)
  )
  (defun *error* (error)
    (if (= (type cmd) 'INT)(setvar "cmdecho" cmd))
    (vla-endundomark Doc)
    (cond
      ((not error))
      ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
      (1 (princ (strcat "\nERROR: " error)))
    )
    (princ)
  )
  (vla-endundomark Doc)
  (vla-startundomark Doc)
  (setvar "cmdecho" 0)
  (command "_.expert" (getvar "expert")) ;; dummy command
  ;;
  ;;
  ;;------------------------------------------------
  ;; CHK_LOCK (c)1995, John F. Uhden, CADvantage
  ;; Function to check for locked layers:
  (defun @check_lock (SS Att / Layer Layers e ent a i Llist elist cmd)
    (setq i 0 Llist nil Layers nil elist nil)
    (repeat (sslength SS)
      (setq e (ssname SS i)
          ent (entget e)
            i (1+ i)
        Layer (cdr (assoc 8 ent))
      )
      (if (= 4 (logand (cdr (assoc 70 (tblsearch "LAYER" Layer))) 4))
        (progn
          (setq elist (cons e elist))
          (if (or (not Llist)(not (vl-position (strcase Layer)(mapcar 'strcase Llist))))
            (setq Llist (cons Layer Llist))
          )
        )
      )
      ;; If Att is not nil, then check for attribute layers.
      (if (and Att (= (cdr (assoc 0 ent)) "INSERT")(vl-position (cons 66 1) ent))
        (progn
          (setq a (entnext e))
          (while (null (assoc -2 (setq ent (entget a))))
            (setq Layer (cdr (assoc 8 ent))
                  a (entnext a)
            )
            (if (= 4 (logand (cdr (assoc 70 (tblsearch "LAYER" Layer))) 4))
              (progn
                (if (not (vl-position e elist))
                  (setq elist (cons e elist))
                )
                (if (not (vl-position (strcase Layer)(mapcar 'strcase Llist)))
                  (setq Llist (cons Layer Llist))
                )
              )
            )
          )
        )
      )
    )
    (if Llist
      (progn
        (foreach Layer Llist (setq Layers (@addstr Layers Layer 256)))
        (prompt "\nThe following layers are locked...\n")
        (foreach Layer Layers (princ Layer)(princ "\n"))
        (initget "Yes No")
        (if (= (getkword "UNlock them?  <Yes>/No: ") "No")
          (foreach e elist (setq SS (ssdel e SS)))
          (progn
            (setq cmd (getvar "cmdecho"))
            (setvar "cmdecho" 0)
            (foreach Layer Layers
              (command "_.layer" "_UN" Layer "")
            )
            (setvar "cmdecho" cmd)
          )
        )
      )
    )
    SS
  )
  ;;----------------------------------------------
  ;; ADDSTR (c)1995, John F. Uhden, CADvantage
  ;; Function adds to any list a list of comma-delimited
  ;; strings with a maximum length set by limit.
  ;; Simplified (3-08-99)
  (defun @addstr (|list |str |limit / |last)
    (if (= (length |list) 0)
      (cons |str |list)
      (setq |last (last |list)
            |list (if (<= (+ (strlen |last)(strlen |str)) |limit)
                     (subst (strcat |last "," |str) |last |list)
                     (append |list (list |str))
                  )
      )
    )
  )
  ;;--------------------------------------------------------------------------------
  ;; Function to convert angle from degrees to radians
  (defun dtor (ang)
    (* pi (/ ang 180.0))
  )
  ;;----------------------------------------
  ;; Begin the program by selecting objects:
  ;;
  (setq ranges '((0 45 1)(45 90 2)(90 135 3)(135 180 4)(180 225 5)(225 270 6)(270 315 7)(315 360 8)))
  (setq ranges (mapcar '(lambda (x)(list (dtor (car x))(dtor (cadr x)) (last x))) ranges))
  (foreach range ranges
    (and
      (setq ss (ssget "X" (list '(0 . "TEXT")'(-4 . "<AND")'(-4 . ">=")(cons 50 (car range))'(-4 . "<")(cons 50 (cadr range))'(-4 . "AND>"))))
      (setq ss (@check_lock ss nil)) ; check for locked layers
      (> (setq i (sslength ss)) 0)
      (repeat (sslength ss)
        (setq e (ssname ss (setq i (1- i))))
        (setq ent (entget e))
        (entmod (append ent (list (cons 62 (last range)))))
      )
    )
  )
  (*error* nil)
)
(defun c:TRC ()(c:TextRotColor))

John F. Uhden

0 Likes

Kent1Cooper
Consultant
Consultant

I find that @Ranjit_Singh2's routine doesn't put a 45-degree multiple direction at the start of a new color category, but at the end of one, which means in my test arrangement you don't get equal numbers of objects in each category:

TextColorDir-RS.PNG

 

It could be the same way-down-decimal-places issue that I used the (or) function to get around, or [I didn't evaluate carefully] it could be written without taking into consideration this from Post 1:

   =>0 and =<44 assign color 3, =>45 and =<89 assign color 4, =>90 and =<134 assign color 5 etc.

 

which I took to mean that anything greater than or equal to 45 degrees would be color 4 [but it came out color 3], and similarly the 45-degree multiples would all be the start of a new color.  [Post 1 doesn't really address what to do between 44 and 45, and between 89 and 90, etc., but I assumed those would fall in the under-45 or under-90 class.]

Kent Cooper, AIA
0 Likes

Kent1Cooper
Consultant
Consultant

That one has the same issue:

 

TextColorDir-JU.PNG

 

and it doesn't start with color 3 [easy enough to compensate for], and somehow it doesn't change the color of the last two [I started out with them all at arbitrary but visually distinguishable color 30 -- the orange -- just to confirm in my own routine that existing color overrides would be changed as well as no-override ByLayer color, and those two remained at color 30].

Kent Cooper, AIA
0 Likes

john.uhden
Mentor
Mentor

That's why I used filtering for the various ranges of rotation... no equivocating.

 

He could also specify any color for any range, but I did miss starting at 3 (green).

John F. Uhden

0 Likes

Ranjit_Singh2
Advisor
Advisor

Just a quick screencast showing how all 3 routines execute. They all need little bit fixing.

 

I have fixed my routine. The error was caused by round-off error. It should work now as desired. Thanks for everyone's input.
(vl-load-com)
(defun c:somefunc  (/ ss1 textrot vlaobj lst1 lst2)
 (setq lst1 '(0 45 90 135 180 225 270 315 360)
       lst2 '(3 4 5 6 7 8 9 10))
 (mapcar '(lambda (a)
           (and (= 'ename (type a))
                (mapcar '(lambda (x y z)
                          (setq textrot (/ (* 180 (vla-get-rotation (setq vlaobj (vlax-ename->vla-object a)))) pi))
                          (if (and (>= (atof (rtos textrot 2 4)) x) (< textrot y))
                           (vla-put-color vlaobj z)))
                        lst1
                        (cdr lst1)
                        lst2)))
         (mapcar 'cadr (ssnamex (ssget '((0 . "TEXT,MTEXT"))))))
 (princ))

 

 

0 Likes

john.uhden
Mentor
Mentor

Thanks for the testing.  I hadn't tried Kent's polar array testing.

It was driving me nuts as my selection filtering would not find text with rotations between 335ยฐ and 360ยฐ.

The solution was to change the range limit to 359.99999999999999ยฐ, which I guess is close enough.

John F. Uhden

0 Likes

Kent1Cooper
Consultant
Consultant

@john.uhden wrote:

Thanks for the testing.  I hadn't tried Kent's polar array testing.

It was driving me nuts as my selection filtering would not find text with rotations between 335ยฐ and 360ยฐ.

The solution was to change the range limit to 359.99999999999999ยฐ, which I guess is close enough.


You are up against exactly the issue described between the code and the image in Post 8.  The evaluation in my routine looks at each object's rotation after selecting all of them, and it's not too hard to compensate for that possibility, as I've done before in other routines.  To apply the same kind of thing in selection filtering to select the objects separately for each range would probably require some -4 entries with OR or less-than-more-than evaluations.  I imagine the workaround you describe would occasionally result in something being determined to be in the wrong category from the "other side" of that decimal divide.

Kent Cooper, AIA
0 Likes

john.uhden
Mentor
Mentor

Excellent observation.  Maybe I shouldn't care because I'll never use the routine, but really, does 0.00000000000001ยฐ matter, even if he's building a nuclear power plant?  The blasted plans would probably be published to no closer than a hundredth (feet) or a thousandth (meters).  It could be that he's just painting wagon wheels.

John F. Uhden

0 Likes