Topic: How to stop while loop?

[HasanCAD]

I coaded this lisp but cant stop while loop.
Please help

Code: [Select]

(defun c:ctxt ( / _value data txt1 txtn )
  (vl-load-com)
  (setq data " ")

  (defun _value (str / ATTr)
    (while
      (not
(if (and (setq ATTr (car (nentsel str)))
(member (vla-get-objectname (setq ATTr (vlax-ename->vla-object ATTr))) '("AcDbAttribute" "AcDbText")))
  ATTr
  (progn (princ str) nil)))) ATTr)
 
  (if (setq txt1 (vla-get-textstring (_value "\nSelect First attribute/Text : ")))
    (progn
      (while
(setq txtn (vla-get-textstring (_value "\nSelect Next attribute/Text : ")))
(setq data (strcat data " + " txtn)))
      (setq data (strcat txt1 data ))))
 
  (setq ip (getpoint "\nPick Text insertion point"))

   (entmakex (list (cons 0 "TEXT")
                  (cons 10  ip)
                  (cons 40 (getvar "textsize"))
                  (cons 1  data)))
  )

(princ " Type   CTXT    to invoke the lisp")

[CAB]

I think I would do the routine like this: (quickly done)

Code - Auto/Visual Lisp: [Select]

1. (defun c:ctxt ( / done ent ip string1 string2)
2.   (vl-load-com)
3.  
4.   (defun _getString (ent / obj subent)
5.     (setq obj (vlax-ename->vla-object (car ent)))
6.     (cond
7.       ((vlax-property-available-p obj 'textstring) (vla-get-textstring obj))
8.       ((null (setq subent (nentselp (cadr ent)))) nil)
9.       ((and subent
10.             (setq obj (vlax-ename->vla-object (car subent))))
11.        (if (vlax-property-available-p obj 'textstring)
12.          (vla-get-textstring obj)
13.        )
14.       )
15.     )
16.   )
17.  
18. (while (not done)
19.   (cond
20.     ((and (null string1)
21.           (setq ent (entsel "\nSelect First attribute/Text : ")))
22.       (setq string1 (_getString ent))
23.      )
24.     ((and string1 (null string2)
25.           (setq ent (entsel "\nSelect Next attribute/Text : "))
26.           (setq string2 (_getString ent)))
27.      )
28.     ((and string1 string2 (setq ip (getpoint "\nPick Text insertion point")))
29.       (entmakex (list (cons 0 "TEXT")
30.                   (cons 10  ip)
31.                   (cons 40 (getvar "textsize"))
32.                   (cons 1  (strcat string1 " + " string2))))
33.      (setq done t)
34.      )
35.    ) ; cond
36. ) ; while
37.   (princ)
38. )
39.  
40. (princ " Type   CTXT    to invoke the lisp")

[HasanCAD]

I think I would do the routine like this: (quickly done)

Working good but the routine alow to select one more text
I want to pick more than one text
see attached

[Keith™]

Try something like this for your loop

Code: [Select]

(while (not ATTr)
  (if (not (and (setq ATTr (car (nentsel str)))
(member
  (vla-get-objectname
    (setq ATTr (vlax-ename->vla-object ATTr))
  )
  '("AcDbAttribute" "AcDbText")
)
   )
      )
    (setq ATTr nil)
  )
)

As long as ATTr is nil, the loop will continue to run, once there is a valid value in ATTr the loop will exit.

You will need to ensure that ATTr is always nil upon entering the loop.

[Lee Mac]

Another quick draft:

Code - Auto/Visual Lisp: [Select]

1. (defun c:ctxt ( / _entsel ins nxt str )
2.    
3.     (defun _entsel ( msg / ent )
4.         (while
5.             (progn
6.                 (setvar 'errno 0)
7.                 (setq ent (car (nentsel msg)))
8.                 (cond
9.                     (   (= 7 (getvar 'errno))
10.                         (princ "\nMissed, try again.")
11.                     )
12.                     (   (= 'ename (type ent))
13.                         (if (not (wcmatch (cdr (assoc 0 (entget ent))) "TEXT,ATTRIB"))
14.                             (princ "\nInvalid object selected.")
15.                         )
16.                     )
17.                 )
18.             )
19.         )
20.         (if ent (cdr (assoc 1 (entget ent))))
21.     )
22.  
23.     (if (setq str (_entsel "\nSelect first attribute/text: "))
24.         (progn
25.             (while (setq nxt (_entsel "\nSelect next attribute/text <Done>: "))
26.                 (setq str (strcat str " + " nxt))
27.             )
28.             (if (setq ins (getpoint "\nPick text insertion point: "))
29.                 (entmake
30.                     (list
31.                        '(0 . "TEXT")
32.                         (cons 10 (trans ins 1 0))
33.                         (cons 40 (getvar 'textsize))
34.                         (cons 01 str)
35.                     )
36.                 )
37.             )
38.         )
39.     )
40.     (princ)
41. )

Only compatible in UCS parallel to WCS.

[CAB]

My rework:

Code - Auto/Visual Lisp: [Select]

1. (defun c:ctxt ( / done ent ip string1 string2)
2.   (vl-load-com)
3.  
4.   (defun _getString (ent / obj subent)
5.     (setq obj (vlax-ename->vla-object (car ent)))
6.     (cond
7.       ((vlax-property-available-p obj 'textstring) (vla-get-textstring obj))
8.       ((null (setq subent (nentselp (cadr ent)))) nil)
9.       ((and subent
10.             (setq obj (vlax-ename->vla-object (car subent))))
11.        (if (vlax-property-available-p obj 'textstring)
12.          (vla-get-textstring obj)
13.        )
14.       )
15.     )
16.   )
17.  
18. (setvar "errno" 0) ; must pre set the errno to 0
19. (while (not done)
20.   (cond
21.     ((and (null string1)
22.           (setq ent (entsel "\nSelect First attribute/Text : ")))
23.       (setq string1 (_getString ent))
24.      )
25.     ((and string1 (null string2)
26.           (setq ent (entsel "\nSelect Next attribute/Text : "))
27.           (setq string2 (_getString ent)))
28.      (setq string1 (strcat string1 " + " string2)
29.            string2 nil)
30.      )
31.     ((= (getvar "errno") 52) ; exit if user pressed ENTER
32.      
33.      (if (and string1
34.               (setq ip (getpoint "\nPick Text insertion point")))
35.       (entmakex (list (cons 0 "TEXT")
36.                   (cons 10  ip)
37.                   (cons 40 (getvar "textsize"))
38.                   (cons 1  string1)))
39.      )
40.      (setq done t)
41.      )
42.    ) ; cond
43. ) ; while
44.   (princ)
45. )
46.  
47. (princ " Type   CTXT    to invoke the lisp")

[HasanCAD]

working perfect

Thnax CAB
Thanx LEE

[Lee Mac]

Thnax CAB
Thanx LEE

*Thanks Keith™ 


You're welcome Hasan 

[CAB]

That poor cat. 

[HasanCAD]

Try something like this for your loop

Special thanks for Keith™