Rotate multiple text to first closest layer

Rotate multiple text to first closest layer

Fleww
Advocate Advocate
3,316 Views
27 Replies
Message 1 of 28

Rotate multiple text to first closest layer

Fleww
Advocate
Advocate

2.jpg

1.jpg

First picture what it needs to look like, and second is what we get from program raw file.

I need lisp or plugin what ever to automatize this for me even little. I am wiling to pay for it just need to make sure it works. We hardly need it for work couse I need to rotate each text and put it near this builing in topography. I get it with rotation by cable that coming to house but I want something to put it near first layer it will be Building layer that layer are all houses here. Rotation will be enough. If you need more details please contact me.

0 Likes
Accepted solutions (3)
3,317 Views
27 Replies
Replies (27)
Message 2 of 28

LyleHardin
Advisor
Advisor

This won't rotate text to nearest layer, but it will let you pick two points and place the text accordingly.

pt1 is the text insertion point.

pt2 is the angle the text will head.

Be aware this places plain TEXT, not MTEXT.

It uses the current text height of your text. 

Bare bones and simple (I'm not known for elegant coding).

Hope it helps.

 

(defun C:textr ()
(setq pt1 (getpoint "Select text start ")
pt2 (getpoint "Select direction for text ")
txt (getstring T "Enter Text > ")
) ; setq
(command "text" pt1 "" pt2 txt)
) ; defun

0 Likes
Message 3 of 28

CodeDing
Advisor
Advisor

@Fleww ,

 

hardin has the right idea. This task does not look as if it can be automated, but there are ways to make the cleanup a bit faster. Here's my take. This will continuously allow you to select text items and move/rotate until finished.

(defun c:MT ( / e)
;Move Text
(while (progn (prompt "\nSelect Text (ENTER to Exit): ") (setq e (ssget "+.:E:S" '((0 . "*TEXT")))))
  (setq e (ssname e 0))
  (command "_.MOVE" e "" (cdr (assoc 10 (entget e))) pause)
(setpropertyvalue e "Rotation" 0) (command-s "_.ROTATE" e "" (cdr (assoc 10 (entget e))) pause) );while (princ) );defun

Best,

~DD

0 Likes
Message 4 of 28

LyleHardin
Advisor
Advisor

Ah, yes. That is better for fixing existing text.

Mine assumes you still have to place the text.

0 Likes
Message 5 of 28

Fleww
Advocate
Advocate

I want to thank you for the help, but I need something to automatic rotate to selected first specific layer near it and its not just 1 text its like 2000 text in one time. I need that, Im willing to pay for it. Its dont need to be perfect but it will save me alot of work. I think something like that exist I just need to find it. I hope some plugin or lisp I ll pay for it its worth so much for me.

0 Likes
Message 6 of 28

ronjonp
Advisor
Advisor

Can you post a sample drawing?

0 Likes
Message 7 of 28

LyleHardin
Advisor
Advisor

I think CodeIng's solution is probably best for you.

Even with 2000 pieces of text, it should take only an hour or two using his code.

Getting something to automatically align the text to the nearest line (you say layer, do you mean line?) may work, but I bet it would place some text where you wouldn't expect it to, and being 'automatic' you may not catch the mistakes.

 

 

0 Likes
Message 8 of 28

Sea-Haven
Mentor
Mentor

If the two text items are on different layers then maybe can be done. 

 

My idea is find other text read textstring and just add to other text. Can delete or turn off or put answer on another layer a bit safer.

 

Like other posters really need a dwg with some text before and after.

 

Looking at image can see some problems where auto may pick wrong text.

(defun c:duotxt ( / txt1 obj ob2)
(setvar 'osmode 512)
(while (setq obj (vlax-ename->vla-object (car (entsel "pick 1st text"))))
(setq txt1 (vla-get-textstring obj))
(setq obj2 (vlax-ename->vla-object (car (entsel "pick 2ndt text"))))
(vla-put-textstring obj2 (strcat txt1 (vla-get-textstring obj2)))
)
)
(c:duotxt)

 

 

0 Likes
Message 9 of 28

Fleww
Advocate
Advocate

https://we.tl/t-llh0P7Lme4

This is link of raw and done .dwg drawing of my problem its sample of what I get and what I need to do, it dont need to be perfect. I do it 1 by 1 and it takes too long, and problem is couse I need to rotate like 10k for 1 month.:/

0 Likes
Message 10 of 28

Fleww
Advocate
Advocate

What is CodeIng's solution? Yea its ok to not put me every text in right place its ok for me even if it puts 50% right.

I say first layer couse its text label near first house and they are in Building layer so polyline or line should be ok too.

https://we.tl/t-llh0P7Lme4

This is link how it looks like raw and finished.

0 Likes
Message 11 of 28

Fleww
Advocate
Advocate

No sorry that's not it.

0 Likes
Message 12 of 28

dlanorh
Advisor
Advisor

Try this. You select the text, then the line/polyline segment to align to then the text insertion point. It mimics the autocad move command so you can see the text when you come to place it. It will loop until a null text entry. The text is automatically rotated to readable.

 

Load and type r2r

 

(defun rh:gbbc (obj / ll ur lst c_pt)
  (if (and obj (= (type obj) 'ENAME))  (setq obj (vlax-ename->vla-object obj)))
  (cond (obj
          (vlax-invoke-method obj 'getboundingbox 'll 'ur)
          (setq lst (mapcar 'vlax-safearray->list (list ll ur))
                c_pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car lst) (cadr lst))
          );end_setq
        )
  );end_cond
  c_pt
);end_defun

(vl-load-com)

;;Rotate to Reference Line
(defun c:r2r (/ *error* c_doc sv_lst sv_vals ss flg obj r_ang cnt ang)
  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun
  
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        sv_lst (list 'osmode 'cmdecho)
        sv_vals (mapcar 'getvar sv_lst)
  );end_setq
  
  (mapcar 'setvar sv_lst '(0 0))
  
  (while (not ss)
    (prompt "\nSelect Entities to Rotate : ")
    (setq ss (ssget "_+.:E:S:L" '((0 . "TEXT,MTEXT"))))

    (cond (ss
            (setq r_obj (vlax-ename->vla-object (ssname ss 0))
                  d_cen (rh:gbbc r_obj)
                  tht (vlax-get-property r_obj 'height)
            );end_setq
            
            (while (not flg)
              (setq sel (entsel "\nSelect Alignment Line : "))
              (mapcar 'set '(ent pt) sel)
              (if (vl-position (vlax-get-property (vlax-ename->vla-object ent) 'objectname) (list "AcDbLine" "AcDbPolyline")) (setq flg T) (alert "NOT a Line or Polyline"))
            );end_while
            (setq c_pt (vlax-curve-getclosestpointto ent pt)
                  p_p (vlax-curve-getparamatpoint ent c_pt)
                  r_ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (+ (fix p_p) 0.5)))
                  c_pt (vlax-curve-getpointatparam ent (+ (fix p_p) 0.5))
            );end_setq
            (if (< (/ pi 2) r_ang (* (/ pi 2) 3)) (setq ang (+ r_ang pi)) (setq ang r_ang))
            (if (> ang (* pi 2)) (setq ang (- ang (* pi 2))))
            (vlax-invoke r_obj 'rotate d_cen ang)
            (vla-update r_obj)
            (vlax-invoke r_obj 'move d_cen (acet-ss-drag-move ss d_cen))
            (setq ss nil flg nil)
          )
          (t (setq ss T))
    );end_cond
    
  );end_while
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

I am not one of the robots you're looking for

0 Likes
Message 13 of 28

ronjonp
Advisor
Advisor
0 Likes
Message 14 of 28

Kent1Cooper
Consultant
Consultant

It looks to me as though you want the numbers to align with the closest linework on [I assume] a particular Layer [the small black boxes], and the longer Text to align with the closest linework on another [the grey building outlines, if that's what they are].  I can only assume that in some cases if a routine were to find the closest linework element of any kind, that would be the same for both a number and a longer one.

 

But also, there are contradictions.  Your images say that you want this:

Capture1.PNG

to become this:

Capture2.PNG

but your description suggests that the long string should be only slightly repositioned and given a slightly different rotation, close to where it is to begin with, rather than lined up with a completely different side of the outline.  How should a routine decide to do that instead of align it with the nearest edge, and how could it decide which other edge to use?  And from this starting condition:

Capture3.PNG

the image says you want that changed to this:

Capture4.PNG

in which the long string is not only farther from the nearest building edge linework, but perpendicular  to it, rather than aligned with it.  From your description, shouldn't it be more like this?

Suggestion.PNG

There are other examples in the images of results perpendicular to rather than aligned with nearby linework.  Are there definable criteria to decide which way to do it?

 

The possibility of different Text justifications also complicates things.  Would they all be the same?

 

One of the challenges would be for a routine to find the nearest linework element.  I imagine a crossing-window selection that starts small relative to the Text height, and centered on the Text [or should it be centered on its insertion point?], looking for whatever it finds, and increases in size until it finds some linework-type object.  But should it look for only such a thing on a certain Layer, determined by the Layer of the Text, or maybe by the content of it, if the numbers and longer strings are on the same Layer?  Should it look for only a particular kind of thing [presumably only Lines or Polylines, but maybe Blocks?], or any kind of "linework" objects?  What if at the same try it finds more than one?  If it hits two edges of the same shape near a corner, which edge should it align with?  Etc., etc.

 

Another is where to put  a newly-aligned Text object relative to whatever edge it finds.  Should the longer ones always go on the outside of the building perimeters?  If the perimeters are Lines, I think a routine could have no way of determining to which side to put the Text.  If they're Polylines, there are ways to figure out which side is outside, though they might get it wrong in some situations.

 

A very challenging problem....

Kent Cooper, AIA
0 Likes
Message 15 of 28

ronjonp
Advisor
Advisor

That's quite the break down @Kent1Cooper ! 🙂 If these were my plans I'd structure the data like so for legibility. Sure there might be some manual cleanup but without a drawing it's even harder to solve.

 

image.png

0 Likes
Message 16 of 28

Sea-Haven
Mentor
Mentor

This is 14th post 

 

NEED A SAMPLE DWG before and after

0 Likes
Message 17 of 28

Fleww
Advocate
Advocate

Here is raw and detailed plan with all texts. It's ok to rotate just to first angle by specific layer in this case is(Building), its ok to manual move text cross the dwg just want good angle automatic lisp or whatever, its so anoying manual work.

0 Likes
Message 18 of 28

Kent1Cooper
Consultant
Consultant

So in your "detailed" drawing, the building numbers appear to be all at 0 rotation, not aligned with something nearby as in your earlier image.  For that part only, this sets the rotation to 0 for all Text [or Mtext] objects whose string content starts with any numerical character:

(repeat (setq n (sslength (setq ss (ssget "_X" '((1 . "#*"))))))
(setq edata (entget (ssname ss (setq n (1- n)))))
(entmod (subst '(50 . 0.0) (assoc 50 edata) edata))
)

But I haven't been able to imagine a way to re-position them, if needed [it looks like most are already in what I assume to be good locations].

 

 

This would find all the others [those that don't start with a numerical character]:

 

....(setq ss (ssget "_X" '((1 . "~#*"))))....

But you would then need to step through and do the rotation thing for each individually.  That's the bigger challenge....

 

 

Kent Cooper, AIA
0 Likes
Message 19 of 28

Fleww
Advocate
Advocate

Its like select similar and put rotation to 0. Im very good in AutoCad but this is so hard to make automatic all drawing to have rotation to first polyline or layer, i repeat it dont need to be perfect just to be in line.  ....

0 Likes
Message 20 of 28

Kent1Cooper
Consultant
Consultant
Accepted solution

Give this highly imperfect routine a try.  For numbers, it rotates them to 0 as before.  For other Text/Mtext objects in the User selection, it reaches out with a crossing-window selection centered around the insertion point, that enlarges until it finds something on the "Building" Layer.  When it finds such a thing, it finds the closest point on it to the insertion point of the Text, gets a direction from that, adjusts for the more readable direction, and applies that to the Text.  It does not  do anything with the Text's insertion point, only its rotation.  I find in quickie testing in your "raw" drawing that some of the non-numerical Text objects are at Servicebox Blocks without  any Building right there, so it keeps reaching outward and uses the nearest Building it finds, which can be some distance away.  Also, in some cases the nearest point on the first Building perimeter it finds is on a curve, so the rotation can be not related to nearby straight edges.  But see what you think, as a starting point....

(defun C:TANBE ; = Text Align with Nearest Building Edge
  (/ tss n tobj tins tht cwsi UR LL gotit bss)
  (if (setq tss (ssget '((0 . "*TEXT"))))
    (repeat (setq n (sslength tss)); then
      (setq tobj (vlax-ename->vla-object (ssname tss (setq n (1- n)))))
      (if (wcmatch (vla-get-TextString tobj) "#*"); starts with a number
        (vla-put-rotation tobj 0); then
        (progn ; else -- all others
          (setq
            tins
              (if (and (= (vla-get-ObjectName tobj) "AcDbText") (/= (vla-get-Alignment tobj) 0))
                (vlax-get tobj 'TextAlignmentPoint); then [other-than-Left-Justified Text; = dxf 11]
                (vlax-get tobj 'InsertionPoint); else [Mtext, Left-Justified Text; = dxf 10]
              ); if & tins
            tht (/ (vla-get-Height tobj) 5); [arbitrary proportion...]
            cwsi (list tht tht); = crossing window size increment
            UR tins LL tins; place to start incrementing selection window fromu 
            gotit nil ; [clear previous]
          ); setq
          (while (not gotit)
            (if
              (setq bss
                (ssget
                  "_C" (setq UR (mapcar '+ UR cwsi)) (setq LL (mapcar '- LL cwsi))
                  '((8 . "Building"))
                ); ssget
              ); setq
              (setq gotit T); then -- stop (while) loop
            ); if
          ); while
          (setq
            bldg (ssname bss 0)
            ang
              (angle
                '(0 0 0)
                (vlax-curve-getFirstDeriv bldg
                  (vlax-curve-getParamAtPoint bldg
                    (vlax-curve-getClosestPointTo bldg tins)
                  )
                )
              )
          ); setq
          (if (and (> ang (/ pi 2)) (<= ang (* pi 1.5)))
            (setq ang (+ ang pi)); then -- turn around
          ); if
          (vla-put-rotation tobj ang)
        ); progn
      ); if
    ); repeat
  ); if
  (princ)
); defun
Kent Cooper, AIA
0 Likes