Problem is that i is set outside the WHILE loop and never changes to end the loop.
See in this one I end the while loop by setting elevat to nil
(defun ssget->vla-list (ss / i ename allobj)
(if ss
(progn
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq allobj (cons (vlax-ename->vla-object ename) allobj))
)
allobj
)
)
)
(defun c:autoelevate (/ linework number ent elist elevat
circle *Space* newradius numlines ActDoc bb
pt1 pt2 insxpt midpoint radius increment
count skipped maxrad inc
)
(vl-load-com)
(setq ActDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq *Space* (vlax-get-property
ActDoc
(nth (vla-get-activespace ActDoc) '("PaperSpace" "ModelSpace"))
)
)
(vla-endundomark ActDoc)
(vla-startundomark ActDoc)
(setq radius (getreal "\nEnter starting radius:"))
(while (or (null radius) (<= radius 0))
(setq radius (getreal "\nEnter starting radius greater than 0:"))
)
(setq increment (getreal "\nEnter radius increment:"))
(while (or (null increment) (<= increment 0))
(setq increment (getreal "\nEnter radius increment greater than 0:"))
)
(setq maxrad (getreal "\nEnter maximum radius:"))
(while (or (null maxrad) (< maxrad radius))
(setq maxrad (getreal "\nEnter maximum (greater than radius):"))
)
(setq count 0
skipped 0
)
;|
Step through model space objects, process Text or Mtext objects only
Use BB to get the middle point of the text
Create a point list to circle the text center at each radius, up to MaxRadius
Use ssget CP to gather any objects (see types list) within or crossing that raidus
Update the first one (closest one?) to the desired elevation
You should end the WHILE loop at this point, but it continues on
Or do you want it to continue on?
|;
(vlax-for i (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
(if (vl-position (vla-get-objectname i) '("AcDbMText" "AcDbText")) ; CAB
(progn
(vl-catch-all-apply
'vla-getboundingbox
(list i
'minpoint
'maxpoint
)
)
(setq pt1 (vlax-safearray->list minpoint)
pt2 (vlax-safearray->list maxpoint)
midpoint (mapcar (function (lambda (a b) (/ (+ a b) 2.0))) pt1 pt2) ; CAB
inc (/ (* pi 2) 10)
newradius radius
elevat nil
)
;; This does not change in the WHILE loop
(setq number (vla-get-textstring i) ; CAB relocated
elevat (atoi number)
)
;; --------------------------------------------------- Main Loop
(while (and elevat (<= newradius maxrad)) ; CAB
(setq plist nil
n 0
)
(while (< (setq n (1+ n)) 12) ; CAB
(setq plist (cons (list (polar midpoint (* inc n) newradius)) plist)) ; CAB remove append
)
(setq newradius (+ newradius increment))
(and
(setq linework
(ssget->vla-list
(ssget "_CP"
plist
(list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,ELLIPSE"))
)
)
)
;; why only the first object in the SS ?
(eq (vla-get-elevation (car linework)) 0.0) ; CAB
(not (vla-put-elevation (car linework) elevat)) ; CAB
(not (setq elevat nil)) ; end while loop ; CAB
(setq count (1+ count))
(grtext -2 (strcat (itoa count) " Flat Segments Elevated."))
) ;and
) ;while
;; ---------------------------------------------------- Main Loop
) ;progn
) ;if
) ;vlax-for
(vla-endundomark ActDoc)
(princ (strcat "\nProcess Complete..." (itoa count) " Flat Segments Elevated."))
(princ)
) ;defun autoelevate
(defun c:aev () (c:autoelevate))
