Lisp - I can't figure out where to begin

The drawings I work in often have between 1-3 named ucs's in them. Most
just have "World" and "1". I would like a lisp that "loops" through the
named usc's sequentialy doing a quick plan-enter-enter for each one,
allowing the user to select the coord system they would like to work in.
I'd really like the routine to "step" to the next named ucs each time
it is called, this way the user can just repeat the lisp as many times
as required rather than have to exit out of a loop. I'd also like it to
respect the current ucs rather than start from World every time. For
instance: If the drawing has 3 coordinate systems (World, 1, 2) and the
current ucs=1, I would like the lisp to "step" to ucs=2, not start over
again at World.

Any advise on how to approach this? A looping structure seems like it
will require the user to exit out of hte routine, so I'm guessing I need
to either save a global variable list of the ucs's to test, or, I can
create a local variable list that I test in the routine?

 

Kurt,
You'll probably get better replies after this but this might help you get started:
(no error checking)

Code:

(defun c:UCSToggle (/ *acaddoc* *ucs_col* ActNam NameLst StartNam TogLst)
;---;
(vl-load-com)
;---;
(if (= (getvar "tilemode") 0)
(setvar "tilemode" 1)
)
(setvar "ucsfollow" 1)
;---;
(setq *acaddoc* (vla-get-activedocument (vlax-get-acad-object))
*ucs_col* (vla-get-usercoordinatesystems *acaddoc*)
)
(if (/= (getvar "ucsname") "")
(setq  *ActUcs* (vla-get-ActiveUCS *acaddoc*)
ActNam (vla-get-name *ActUcs*)
)
)
;---;
(vlax-for item *ucs_col*
(setq NameLst (cons (vla-get-name item) NameLst)
)
)
(if ActNam
(progn
(setq StartNam (member ActNam NameLst)
)
(if (> (length NameLst)(length StartNam))
(progn
(setq TogLst (reverse StartNam))
(repeat (- (length NameLst)(length StartNam))
(setq TogLst (cons (car NameLst) TogLst)
NameLst (cdr NameLst)
)
)
(setq TogLst (reverse TogLst))
)
(setq TogLst NameLst)
)                              ;end if
)
(setq TogLst NameLst)
)
;---;
(foreach nam TogLst
(vla-put-ActiveUCS *acaddoc* (vla-item *ucs_col* nam))
(princ nam)(prompt "\n ")
(getpoint "Hit < escape > to exit.")
)
;---;
(if (= (length TogLst) 0)
(progn (princ "\nNamed UCS not found.")(princ))
(princ)
)
;---;
)

Bill

 

Thanks Bill. I'm going to need to do a little studying to figure out
what you wrote.

 

This section is for arranging the list of named UCS's so that it begins with the active UCS.

Code:

(if ActNam
(progn
(setq StartNam (member ActNam NameLst)
)
(if (> (length NameLst)(length StartNam))
(progn
(setq TogLst (reverse StartNam))
(repeat (- (length NameLst)(length StartNam))
(setq TogLst (cons (car NameLst) TogLst)
NameLst (cdr NameLst)
)
)
(setq TogLst (reverse TogLst))
)
(setq TogLst NameLst)
)                              ;end if
)
(setq TogLst NameLst)
)

This:

Code:

(setq TogLst NameLst)

would suffice it you don't mind it starting at the begining of the active UCS list.

HTH

Bill

 

Thanks.