Selection Set - How To Include the Number of Text Characters?

[GregGleason]

I have code that mostly works.

 

The idea is to capture a defined crossing region, looking for TEXT objects that have an X origin of 19.0945 and a style of "MAT-LIST".

 

But there is one more criterion I want to add to the selection set, and that is the number of characters in the TEXT.  In this case I want it to be 14.

 

I also want it to change the character width of the selection, but I haven't figured that out.

 

Last, I want to eventually make this a function that I can pass arguments, but I think that is fairly straightforward.

 

(defun c:ZZZ ( / ss1 zcharlen zwidfac zmove zfrom zto)
	(setq zcharlen 10)
	(setq zwidfac 0.9)
	(setq zmove 0.2)
	(setq zfrom (list 0. 0. 0.))
	(setq zto (list (- 0. zmove) 0. 0.))
	(princ (strcat "\n zcharlen ...: " (rtos zcharlen 2 0)))
	(princ (strcat "\n zwidfac ....: " (rtos zwidfac 2 0)))
	(princ (strcat "\n zmove ......: " (rtos zmove 2 4)))
	(princ (strcat "\n\n zfrom ......: " (rtos (car zfrom) 2 4) "," (rtos (cadr zfrom) 2 4)))
	(princ (strcat "\n zto ........: " (rtos (car zto) 2 4) "," (rtos (cadr zto) 2 4)))
	(if (setq ss1 (ssget "_C" '(19.0000 2.7000) '(19.8900 15.7608) '((0 . "TEXT")(8 . "MAT-LIST")(-4 . "*,=") (11 19.0945 0.0 0.0))))
		(command "_.MOVE" ss1 "" "_non" zfrom "_non" zto)
		(princ "\nNone Found")
	);; End of if
	(princ)
)

 

Any suggestions on how to get it the rest of the way there?

 

Greg

 

 

[rlx]

to get you on your way

(defun c:t1 ( / w l p1 p2 ss d )
  (setq w (getreal "\nEnter width factor") l (getint "\nLength of string")
        p1 (getpoint "\nSelect first corner : ") p2 (getcorner p1 "\nSecond corner : "))
  (if (and w l p1 p2 (setq ss (ssget "_C" p1 p2 (list '(0 . "TEXT") (cons 1 (make? l))))))
    (foreach e (SS->Lst ss) (setq d (entget e))(setq d (mod 41 w d))(entmod d)(entupd e))(princ"\nNothing selected"))
  (princ)
)

(defun make? ( i / s ) (setq s "")(repeat i (setq s (strcat s "?"))) s)
(defun SS->Lst (ss / i l) (setq i 0 l '()) (repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l)
(defun mod (c v d) (if (assoc c d) (setq d (subst (cons c v)(assoc c d) d))(setq d (append d (list (cons c v))))))

[GregGleason]

3 hours ago, rlx said:

to get you on your way

 

(defun c:t1 ( / w l p1 p2 ss d )
  (setq w (getreal "\nEnter width factor") l (getint "\nLength of string")
        p1 (getpoint "\nSelect first corner : ") p2 (getcorner p1 "\nSecond corner : "))
  (if (and w l p1 p2 (setq ss (ssget "_C" p1 p2 (list '(0 . "TEXT") (cons 1 (make? l))))))
    (foreach e (SS->Lst ss) (setq d (entget e))(setq d (mod 41 w d))(entmod d)(entupd e))(princ"\nNothing selected"))
  (princ)
)

(defun make? ( i / s ) (setq s "")(repeat i (setq s (strcat s "?"))) s)
(defun SS->Lst (ss / i l) (setq i 0 l '()) (repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l)
(defun mod (c v d) (if (assoc c d) (setq d (subst (cons c v)(assoc c d) d))(setq d (append d (list (cons c v))))))

 

 

Thank you rlx.

 

I tried it and it works, sort of.  It does not distinguish the origin like my original so I adapted yours to do what I thought would be the fix but it did not work.

 

(defun c:t1 ( / w l p1 p2 ss d )
  (setq w (getreal "\nEnter width factor : ") l (getint "\nLength of string : ")
        p1 (getpoint "\nSelect first corner : ") p2 (getcorner p1 "\nSecond corner : "))
  (if (and w l p1 p2 (setq ss (ssget "_C" p1 p2 (list '(0 . "TEXT") '(8 . "MAT-LIST") '(-4 . "*,=") '(11 19.0945 0.0 0.0) (cons 1 (make? l))))))
    (foreach e (SS->Lst ss) (setq d (entget e))(setq d (mod 41 w d))(entmod d)(entupd e))(princ"\nNothing selected"))
  (princ)
)

(defun c:t2 ( / w l p1 p2 ss d )
  (setq w (getreal "\nEnter width factor : ") l (getint "\nLength of string : ")
        p1 (list 19.0000 2.7000 0.) p2 (list 19.8900 15.7608 0.))
  (if (and w l p1 p2 (setq ss (ssget "_C" p1 p2 (list '(0 . "TEXT") '(8 . "MAT-LIST") '(-4 . "*,=") '(11 19.0945 0.0 0.0) (cons 1 (make? l))))))
    (foreach e (SS->Lst ss) (setq d (entget e))(setq d (mod 41 w d))(entmod d)(entupd e))(princ"\nNothing selected"))
  (princ)
)

(defun make? ( i / s ) (setq s "")(repeat i (setq s (strcat s "?"))) s)
(defun SS->Lst (ss / i l) (setq i 0 l '()) (repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l)
(defun mod (c v d) (if (assoc c d) (setq d (subst (cons c v)(assoc c d) d))(setq d (append d (list (cons c v))))))

Also, is there a way to also include a move with a prompted value?

 

Greg

[rlx]

(defun c:ZZZ ( / ss1 zcharlen zwidfac zmove zfrom zto d e)
  ;;; defuns
  (defun make? ( i / s )
    (setq s "")(repeat i (setq s (strcat s "?"))) s)
  (defun SS->Lst (ss / i l)
    (setq i 0 l '()) (repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l)
  (defun mod (c v d)
    (if (assoc c d) (setq d (subst (cons c v)(assoc c d) d))(setq d (append d (list (cons c v))))))
  ;;; setqs
  (and
    (setq zfrom (getpoint "\nEnter base point to move FROM :"))
    (setq zto (getdist zfrom "\nEnter point to move selection TO : "))
    (setq zto (getvar 'lastpoint))
  )
  (setq zcharlen 10 zwidfac 0.9 zmove 0.2)
  ;;; summary
  (princ (strcat "\n zcharlen ...: " (rtos zcharlen 2 0)))
  (princ (strcat "\n zwidfac ....: " (rtos zwidfac 2 0)))
  (princ (strcat "\n zmove ......: " (rtos zmove 2 4)))
  (princ (strcat "\n\n zfrom ......: " (rtos (car zfrom) 2 4) "," (rtos (cadr zfrom) 2 4)))
  (princ (strcat "\n zto ........: " (rtos (car zto) 2 4) "," (rtos (cadr zto) 2 4)))
  ;;; action
  (if (setq ss1 (ssget "_C" '(19.0000 2.7000) '(19.8900 15.7608) '((0 . "TEXT")(8 . "MAT-LIST")
        (1 . "??????????") ;| only text with 10 characters |; (-4 . "*,=") (11 19.0945 0.0 0.0))))
    (progn
      (if (and zfrom zto)(command "_.MOVE" ss1 "" "_non" zfrom "_non" zto))
      (foreach e (SS->Lst ss1) (setq d (entget e))(setq d (mod 41 zwidfac d))(entmod d)(entupd e))
    )
    (princ "\nNone Found")
  )
  (princ)
)

what's with the (-4 . "*,=") (11 19.0945 0.0 0.0)?

also zmove is 0.2, if base point is zfrom, zto should be a polar point at an angle else why need zto at all?

 

 

awel, I'm tired... speaking of (a) tire , I suspect some joker (maybe thé joker) has put a staple in my bicycle tire this afternoon because pin looked too small to got there accidentally so had to walk home (and this was not the first time) so gonna get me an airless tire. Should solve any future problems , whether this was accidentally or not.

 

... so...

[GregGleason]

rlx, that code pretty much did it.  I added the extra bit of defining the "x" origin point of the text if it is >= a set value.

 

I was not able to figure out the slick "make?" function to pad to the correct number of variables (in this case 10) that you provided in the first code you provided.  I am amazed at your talent as I didn't understand what that did the first time until your last revision of my code.  Can it be incorporated in my revised code?

 

So here is what I ended up with, (trying to automate this so the user does not have to dialog with the code):

 

(defun c:ZZZ ( / ss1 zcharlen zwidfac zmove zfrom zto d e)
  ;;; defuns
  (defun make? ( i / s )
    (setq s "")(repeat i (setq s (strcat s "?"))) s)
  (defun SS->Lst (ss / i l)
    (setq i 0 l '()) (repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l)
  (defun mod (c v d)
    (if (assoc c d) (setq d (subst (cons c v)(assoc c d) d))(setq d (append d (list (cons c v))))))
  ;;; setqs
  (and
    ;(setq zfrom (getpoint "\nEnter base point to move FROM :"))
    ;(setq zto (getdist zfrom "\nEnter point to move selection TO : "))
    ;(setq zto (getvar 'lastpoint))
  )
  (setq zcharlen 10 zwidfac 0.9 zmove 0.2 zfrom (list 0. 0. 0.) zto (list (- 0. zmove) 0. 0.))
  ;;; summary
  (princ (strcat "\n zcharlen ...: " (rtos zcharlen 2 0)))
  (princ (strcat "\n zwidfac ....: " (rtos zwidfac 2 0)))
  (princ (strcat "\n zmove ......: " (rtos zmove 2 4)))
  (princ (strcat "\n\n zfrom ......: " (rtos (car zfrom) 2 4) "," (rtos (cadr zfrom) 2 4)))
  (princ (strcat "\n zto ........: " (rtos (car zto) 2 4) "," (rtos (cadr zto) 2 4)))
  ;;; action
  (if (setq ss1 (ssget "_C" '(19.0000 2.7000) '(19.8900 15.7608) '((0 . "TEXT")(8 . "MAT-LIST")(-4 . ">=,*,*")(10 19.0944 0.0 0.0)
        (1 . "??????????") ;| only text with 10 characters |; )))
    (progn
      (if (and zfrom zto)(command "_.MOVE" ss1 "" "_non" zfrom "_non" zto))
      (foreach e (SS->Lst ss1) (setq d (entget e))(setq d (mod 41 zwidfac d))(entmod d)(entupd e))
    )
    (princ "\nNone Found")
  )
  (princ)
)

I appreciate the help and I learned something along the way.

 

Greg

[rlx]

Glad you were able to learn something

 

Have to go to the end-of-the-year-party from my agency now so laters alligators...

 

  

[rlx]

(defun c:ZZZ ( / ss1 zcharlen zwidfac zmove zfrom zto d e)
  ;;; defuns
  (defun make? ( i / s )
    (setq s "")(repeat i (setq s (strcat s "?"))) s)
  (defun SS->Lst (ss / i l)
    (setq i 0 l '()) (repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l)
  (defun mod (c v d)
    (if (assoc c d) (setq d (subst (cons c v)(assoc c d) d))(setq d (append d (list (cons c v))))))
  ;;; setqs
  (setq zwidfac 0.9 zmove 0.2 zfrom (list 0. 0. 0.) zto (list (- 0. zmove) 0. 0.))
  (setq zcharlen (getint "\nString length : "))
  ;;; summary
  (princ (strcat "\n zcharlen ...: " (rtos zcharlen 2 0)))
  (princ (strcat "\n zwidfac ....: " (rtos zwidfac 2 0)))
  (princ (strcat "\n zmove ......: " (rtos zmove 2 4)))
  (princ (strcat "\n\n zfrom ......: " (rtos (car zfrom) 2 4) "," (rtos (cadr zfrom) 2 4)))
  (princ (strcat "\n zto ........: " (rtos (car zto) 2 4) "," (rtos (cadr zto) 2 4)))
  ;;; action
  (if (setq ss1 (ssget "_C" '(19.0000 2.7000) '(19.8900 15.7608)
         ; use list here so (cons 1 is evaluated
         (list '(0 . "TEXT") '(8 . "MAT-LIST") '(-4 . ">=,*,*") '(10 19.0944 0.0 0.0)
         (cons 1 (make? zcharlen)))))
    (progn
      (if (and zfrom zto)(command "_.MOVE" ss1 "" "_non" zfrom "_non" zto))
      (foreach e (SS->Lst ss1) (setq d (entget e))(setq d (mod 41 zwidfac d))(entmod d)(entupd e))
    )
    (princ "\nNone Found")
  )
  (princ)
)

 

using the quote function can be confusing in the beginning. Its like trying to explain to a kid that 25% from 100 is the same as 100 * 0.25 or 100 / 4. Its not difficult but when you begin to learn something you accept this as the truth, only to find out there are more versions of the truth out there...

 

Use the quote function whenever you can because its faster when something doesn't have to be calculated (evaluated) first. Does it really matter for little appies?... nope... on a human scale you cant tell the difference. Others will say , no no , it does matter and come with an impressive benchmark program and they all mean diddly.

 

When does it matter then... well , on very large data sets it can matter to try to make something faster. I wrote a program a couple of years ago to generate instrument loop diagrams using an excel workbook. First I wrote it like , start new drawing , open excel , read data , draw loop , save loop. Next!

This proved to be frustratingly slow. Every time I had to open & close the excel workbook which took a long time. So I changed strategy and re-wrote it as , start with empty drawing , open excel and read first data line, draw loop , save loop , kick out loop (saveas) , purge drawing , read next data line , draw loop etc. Now I only had to open Excel once. This became a major speed improvement.

 

So to wrap it up (and I can get back to my work) , when data you use is fixed , you can use quote , when data (or part of your data) is not fixed, use list.

 

cheers

Edited December 20, 2019 by rlx

[GregGleason]

rlx, thank you for all of the help.  Here is the finished function:

  ;;; defuns
  (defun make? ( i / s )
    (setq s "")(repeat i (setq s (strcat s "?"))) s)
  (defun SS->Lst (ss / i l)
    (setq i 0 l '()) (repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l)
  (defun mod (c v d)
    (if (assoc c d) (setq d (subst (cons c v)(assoc c d) d))(setq d (append d (list (cons c v))))))
(defun TABA ( acharlen awidfac amove aminx aminy amaxx amaxy aoriginx / ss1 zcharlen zwidfac zmove zfrom zto d e)
  ;;; setqs
  ;(and
    ;(setq zfrom (getpoint "\nEnter base point to move FROM :"))
    ;(setq zto (getdist zfrom "\nEnter point to move selection TO : "))
    ;(setq zto (getvar 'lastpoint))
  ;)
  ;(setq zcharlen 10 zwidfac 0.9 zmove 0.2 zfrom (list 0. 0. 0.) zto (list (- 0. zmove) 0. 0.))
  (setq zcharlen acharlen zwidfac awidfac zmove amove zfrom (list 0. 0. 0.) zto (list (- 0. zmove) 0. 0.))
  ;;; summary
  (princ (strcat "\n zcharlen ...: " (rtos zcharlen 2 0)))
  ;;; action
  (if (setq ss1 (ssget "_C" (list aminx aminy) (list amaxx amaxy)
         ; use list here so (cons 1 is evaluated
         (list '(0 . "TEXT") '(8 . "MAT-LIST") '(-4 . ">=,*,*") (cons 10 (list aoriginx 0.0 0.0))
         (cons 1 (make? zcharlen)))))
    (progn
      (if (and zfrom zto)(command "_.MOVE" ss1 "" "_non" zfrom "_non" zto))
      (foreach e (SS->Lst ss1) (setq d (entget e))(setq d (mod 41 zwidfac d))(entmod d)(entupd e))
          (princ (strcat "\n zwidfac ....: " (rtos zwidfac 2 0)))
          (princ (strcat "\n zmove ......: " (rtos zmove 2 4)))
          (princ (strcat "\n\n zfrom ......: " (rtos (car zfrom) 2 4) "," (rtos (cadr zfrom) 2 4)))
          (princ (strcat "\n zto ........: " (rtos (car zto) 2 4) "," (rtos (cadr zto) 2 4)))
          (princ (strcat "\n\n Xing low rt: " (rtos aminx 2 4) "," (rtos aminy 2 4)))
          (princ (strcat "\n Xing up lt..: " (rtos amaxx 2 4) "," (rtos amaxy 2 4) "\n"))
          (princ (strcat "\n Xorigin.....: " (rtos aoriginx 2 4) "\n"))
    )
    (princ "\n  None Found\n")
  )
  (princ)
)

Here are a few of the calls to the function:

(TABA 8 1.000 0.09546 19.0000 2.7000 19.8900 15.7608 19.0944)
(TABA 9 1.000 0.19092 19.0000 2.7000 19.8900 15.7608 19.0944)
(TABA 10 1.000 0.28638 19.0000 2.7000 19.8900 15.7608 19.0944)
(TABA 11 1.000 0.38184 19.0000 2.7000 19.8900 15.7608 19.0944)

The output from the program:

 zcharlen ...: 8
  None Found

 zcharlen ...: 9
  None Found

 zcharlen ...: 10
 zwidfac ....: 1
 zmove ......: 0.2864

 zfrom ......: 0.0000,0.0000
 zto ........: -0.2864,0.0000

 Xing low rt: 19.0000,2.7000
 Xing up lt..: 19.8900,15.7608

 Xorigin.....: 19.0944

 zcharlen ...: 11
  None Found

 

Your help got me to where I could take the program and supply many arguments and not write 14 separate programs.

 

I appreciate all of the help!

 

Greg

[rlx]

Glad you've got your appie working the way you want it!

 

best wishes for 2020