Can't Discover

I can't discover what is wrong with this routine. Thank you for helping me
to get at this point.

(defun c:talign () ; i will make local later
(setq gp (getpoint "\nSpecify a point:"))
(setq gx (car gp))
(prompt "\nSelect Text to align")
(setq gt (ssget '((0 . "MTEXT,TEXT" ))))
(setq n (sslength gt))
(setq index 0)
(repeat n
(setq b1 (entget (ssname gt index)))
(setq index (1+ index))
(setq b (assoc 0 b1))
(if (or (= "TEXT" (cdr b)) (= "MTEXT" (cdr b)))
(progn
(setq c (cadr (assoc 10 b1)))
(setq b2 (subst gx c))
(entmod b2)
)
)
)
(princ)
)
(princ)

John

 

step though each var after you run it by typing !gp or !c at the command
prompt and find out the last one that gets set...

then you know where your error is hiding.

Jaime

 

I posted "I think, everyone here" problems after tried everything....

 

Hi John

With some small modifications it will work:

(defun c:talign ( / gp gt bl np el)
(setq gp (getpoint "\nSpecify a point:"))
(prompt "\nSelect Text to align... ")
(if (setq gt (ssget '((0 . "MTEXT,TEXT" ))))
(while (setq b1 (ssname gt 0))
(setq el (entget b1)
np (cons (car gp) (cddr (assoc 10 el)))
el (subst (cons 10 np) (assoc 10 el) el)
)
(entmod el)
(ssdel b1 gt)
)
)
(princ)
)

Cheers

 

Juerg Menzi,

Thank you very much. I will study where i was making mistake.... Again,
thank you.

John

 

Depending on the justification you need to change either (assoc 10) or (assoc 11).

Tim

 

Hi John

Welcome...
I will try to explain where you've made some mistakes and what I've done:

(defun c:talign () ; i will make local later
(setq gp (getpoint "\nSpecify a point:"))
(setq gx (car gp))
(prompt "\nSelect Text to align")
(setq gt (ssget '((0 . "MTEXT,TEXT" ))))
(setq n (sslength gt))
(setq index 0)
(repeat n
(setq b1 (entget (ssname gt index)))
(setq index (1+ index))
(setq b (assoc 0 b1)) ;this and next check are not necessary because you've
(if (or (= "TEXT" (cdr b)) (= "MTEXT" (cdr b))) ;set same filter at ssget
(progn
(setq c (cadr (assoc 10 b1))) ;extracts X coordinate from point
(setq b2 (subst gx c)) ;check the help file for 'subst' syntax
(entmod b2) ;you've to 'entmod' the whole entity list
)
)
)
(princ)
)

In meantime I've add another improvement to prevent 'Enter' at getpoint:
(defun c:talign ( / gp gt b1 np el)
(initget 1) ;prevent from Null, otherwise you get an error
(setq gp (getpoint "\nSpecify a point:"))
(prompt "\nSelect Text to align... ")
(if (setq gt (ssget '((0 . "MTEXT,TEXT" )))) ;check for selection set
(while (setq b1 (ssname gt 0)) ;scan the selection set by remove current ent
(setq el (entget b1) ;extract entity list
np (cons (car gp) (cddr (assoc 10 el))) ;replace X coord
el (subst (cons 10 np) (assoc 10 el) el) ;modify the entity list
)
(entmod el) ;modify entity
(ssdel b1 gt) ;remove processed entity from selection set
)
)
(princ)
)

Cheers

 

Jurg,

Your routine only works if the text is justified to "left". Here is one I wrote. It aligns text to a text entity you select, but you can change it to match your need.

Code:

(defun c:lu()

(command "undo" "group")

(setvar "errno" 0)
(setq al1 nil)
(while (and (/= 52 (getvar "errno")) (not al1))
(initget "X Y")
(setq al1(nentsel "\nSelect master text to align along X axis or <\"Y\"> to align along Y axis:  "))
)
(if (or (= al1 "y") (= al1 "Y"))
(progn
(setq al1 nil)
(while (and (/= 52 (getvar "errno")) (not al1))
(setq al1 (nentsel "\nSelect master text to align along Y axis:  "))
)
(setq tset0 al1)
(setq al1 "y")
)
(progn
(setq tset0 al1)
(setq al1 "x")
)
)

(if (= tset0 nil)
(vl-exit-with-value nil)
(progn
(setq tset1 (entget (car tset0)))
(redraw (cdr (assoc -1 tset1)) 3)
(setq al2 (cdr (assoc 72 tset1)))
(setq al3 (cdr (assoc 73 tset1)))
(if (and (= al2 0) (= al3 0))
(progn
(setq alx (cadr(assoc 10 tset1)))
(setq aly (caddr(assoc 10 tset1)))
)
(progn
(setq alx (cadr(assoc 11 tset1)))
(setq aly (caddr(assoc 11 tset1)))
)
)
)
)

(setq tset2 (ssget '((0 . "TEXT"))))
(if (= tset2 nil)
(progn
(setq tlng1 0)
(redraw (cdr (assoc -1 tset1)) 4)
)
(setq tlng1 (sslength tset2))
)
(setq tlng2 0)

(repeat tlng1
(progn
(setq tset3 (ssname tset2 tlng2))
(setq tset4 (entget tset3))
(setq al4 (cdr (assoc 72 tset4)))
(setq al5 (cdr (assoc 73 tset4)))
(if (and (= al4 0) (= al5 0))
(progn
(setq al6 (cdr (assoc 10 tset4)))
(cond
((= al1 "x")
(setq al6 (subst alx (car al6) al6))
)
((= al1 "y")
(setq al6 (subst aly (cadr al6) al6))
)
)
(setq tset4 (subst (cons 10 al6) (assoc 10 tset4) tset4))
(redraw (cdr (assoc -1 tset1)) 4)
)
(progn
(setq al6 (cdr (assoc 11 tset4)))
(cond
((= al1 "x")
(setq al6 (subst alx (car al6) al6))
)
((= al1 "y")
(setq al6 (subst aly (cadr al6) al6))
)
)
(setq tset4 (subst (cons 11 al6) (assoc 11 tset4) tset4))
(redraw (cdr (assoc -1 tset1)) 4)
)
)
(entmod tset4)
(setq tlng2 (1+ tlng2))
)
)

(command "undo" "end")
(princ)

)

Tim

 

Thanks for your input. I think the routine nothing to do with justified, it
just replacing "x" coordinate. Correct me if I'm wrong.



I tested it in ADT 3.3 and it work fine.

wrote. It aligns text to a text entity you select, but you can change it to
match your need.

 

From AutoCAD help:
<snip>
If group 72 and/or 73 values are nonzero then the first alignment point values are ignored and AutoCAD calculates new values based on the second alignment point and the length and height of the text string itself (after applying the text style). If the 72 and 73 values are zero or missing, then the second alignment point is meaningless.

73 Vertical text justification type (optional, default = 0): integer codes (not bit-coded):
0 = Baseline; 1 = Bottom; 2 = Middle; 3 = Top
See the Group 72 and 73 integer codes table for clarification

72 Horizontal text justification type (optional, default = 0) integer codes (not bit-coded)
0 = Left; 1= Center; 2 = Right
3 = Aligned (if vertical alignment = 0)
4 = Middle (if vertical alignment = 0)
5 = Fit (if vertical alignment = 0)
See the Group 72 and 73 integer codes table for clarification

<snip>

Where "assoc 10" is the first alignment point and "assoc 11" is the second. When I was writing mine I couldn't get anything but left justified text to move, then I check and revisied it and now all text (almost all, haven't really tested fit or align) line up. But if you say his works then maybe I'm doing too much stuff and can simplify mine.

Tim

 

John,

Also I tried his with right justified text in A2K2 and it didn't work. That is why I posted my code.

Tim

 

I tested it in ADT 3.3 and it work fine.



Yes, I don't have any problems using this routine.



It's not really text align...

I maybe call it "text justification align" because it aligns insert
point............ Doesn't matter it justification topleft, topright...
Just align insert point....



John

values are ignored and AutoCAD calculates new values based on the second
alignment point and the length and height of the text string itself (after
applying the text style). If the 72 and 73 values are zero or missing, then
the second alignment point is meaningless.

second. When I was writing mine I couldn't get anything but left justified
text to move, then I check and revisied it and now all text (almost all,
haven't really tested fit or align) line up. But if you say his works then
maybe I'm doing too much stuff and can simplify mine.

 

your codes work fine too but I was not able to select mtext. I really dont
need to align "Y" coordinate.

 

Juerg Menzi,

Thank you. it really help out a lot..........

Please see my new routine that i learn from you.

(defun C:AreaCreat ( / gt b1)
(if (setq gt (ssget "x" '((0 . "AEC_SPACE" ))))
(while (setq b1 (ssname gt 0))
(command "-AecAreaCreateFromObject" "o" b1 "" "" "")
(ssdel b1 gt) ;still trying to understand it well. I think it deleting
entity from gt
)
)
(print)
)

Again, thank you

John

 

Hi John

Welcome...

The meaning of this kind of stepping through a selection set is:
- Less code and variables: no item counter, no increment
- You've not to determine the length of the selection set
- Increase speed: while is faster than repeat, shorten the selection set
while looping gives faster access compared with indexing
Important:
Only applicable if you don't need this selection set for other purposes!

(while (setq CurEnt (ssname SelSet 0)) ;extract first entity from SelSet
(DoYourStuffWithCurEnt)
(ssdel CurEnt SelSet) ;remove first entity from SelSet
)
compared with:
(setq Counter 0)
(repeat (sslength SelSet)
(setq CurEnt (ssname SelSet Counter)
Counter (1+ Counter)
)
(DoYourStuffWithCurEnt)
)

Cheers

 

Hi,

I tested 2 solutions with a timer :

(defun c:T1 ( / )
(setq SelSet (ssget "X"))
(setq Temps_Debut (getvar "DATE"))
(while (setq CurEnt (ssname SelSet 0))
(princ (strcat "\r" (cdr (assoc 0 (entget CurEnt )))))
(ssdel CurEnt SelSet)
)
(setq Temps_Fin (getvar "DATE"))
(setq Secondes (* 86400.0 (- (- Temps_Fin Temps_Debut ) (fix (- Temps_Fin
Temps_Debut )))))
(princ (strcat "\n Temps de traitement : " (rtos Secondes 2 1) "
secondes." ))
(princ)
)

(defun c:T2 ( / )
(setq SelSet (ssget "X"))
(setq Temps_Debut (getvar "DATE"))
(setq Counter 0)
(setq SelSet_length (sslength SelSet))
(repeat SelSet_length
(setq CurEnt (ssname SelSet Counter))
(setq Counter (1+ Counter))
(princ (strcat "\r" (cdr (assoc 0 (entget CurEnt )))))
)
(setq Temps_Fin (getvar "DATE"))
(setq Secondes (* 86400.0 (- (- Temps_Fin Temps_Debut ) (fix (- Temps_Fin
Temps_Debut )))))
(princ (strcat "\n Temps de traitement : " (rtos Secondes 2 1) "
secondes." ))
(princ)
)

I get with 20000 lines :

Commande: t1
LINE
Temps de traitement : 6.5 secondes.

Commande:
Commande: t2
LINE
Temps de traitement : 3.2 secondes.

ok I agree, variation isn't significant, may be 3 seconds by days!

Total time for second solution is linear with the number of elements.
In certain cases it's very interesting. First solution is more
elegant. First solution is more powerful on reasonable selections, but
sometimes one needs in the process a counter like :
(princ (strcat "\rPolylignes : " (itoa Counter ) " ......
In this case second solution is necessary.

Bruno Toniutti
(sorry for my english level)

 

Hi Bruno

Seems that I was wrongly informed about the speed relation. Anyway, thank you
for the benchmark test.

Cheers