ADD OPTION SELECTION TO MY LISP ROUTINE

ADD OPTION SELECTION TO MY LISP ROUTINE

venturini.anthony
Advocate Advocate
1,597 Views
15 Replies
Message 1 of 16

ADD OPTION SELECTION TO MY LISP ROUTINE

venturini.anthony
Advocate
Advocate

im trying to create a lisp routine to edit layer transparency. how would i add a prefix to this code to run different options. for instance if the command is run it will give you an option to pick a,b or c. if a is picked then the following code is run, if b is picked, a different variation of the code is run. the current code below works for the layers, but id like to add the selection feature. 

 

(vl-load-com)

(defun c:fade (/ *error* c_doc c_lyrs)

; localised error function
(defun *error* ( msg )
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
(princ)
);_end_*error*_defun

;initial setups go here
(setq c_doc (vla-get-ActiveDocument (vlax-get-acad-object))
c_lyrs (vla-get-layers c_doc)
);end_setq

;start of altering drawing
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
(vla-startundomark c_doc)
(vlax-for lyr c_lyrs
(if (or (wcmatch (vla-get-name lyr) "*|*" ) (wcmatch (vla-get-name lyr) "XR-*" ))
(progn
(command "-LAYER" "_TR" 60 (vla-get-name lyr) "")
);end_progn
);end_if
(if (or (wcmatch (vla-get-name lyr) "XR-BASE|B-PROPERTY" ) (wcmatch (vla-get-name lyr) "XR-BASE|B-NONPROPERTY" ) (wcmatch (vla-get-name lyr) "XR-BASE|B-PROPERTY-STREET-TEXT" ) (wcmatch (vla-get-name lyr) "XR-TITLE|*" ))
(progn
(command "-LAYER" "_TR" 0 (vla-get-name lyr) "")
);end_progn
);end_if
);end-for
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
(princ)
);end_defun

0 Likes
1,598 Views
15 Replies
Replies (15)
Message 2 of 16

john.uhden
Mentor
Mentor

@venturini.anthony 

I would probably subdivide the program into localized subfunctions...

(defun c:Topping ( / ans do_A do_B do_C)

(defun do_A ...)

(defun do_B ...)

(defun @do_C ...)

;; then use getkword...

(initget "Mushrooms "Peppers Sausage")

(setq ans (getkword "\nSelect a topping <Mushrooms>/Peppers/Sausage: "))

(cond

  ((or (not ans)(= ans "Mushrooms"))(@do_A))

  ((= ans "Peppers")(do_B))

  ((= ans "Sausage")(do_C))

)

;; Notice we made Mushrooms the default ('cause that what my wife likes).

;; And the user doesn't have to type in "Sausage" because we capitalized the first letters, so a simple "S" (upper or lower case) will suffice.

John F. Uhden

0 Likes
Message 3 of 16

Kent1Cooper
Consultant
Consultant

As an aside, be aware that you can assign options to more than one Layer at a time, in comma-separated format including wildcards, and do more than one option within a single Layer command.  You should be able to replace your entire (vlax-for ...  function with just:

 

(command "_.layer"

  "_tr" 60 "*|*,XR-*"

  "_tr" 0 "XR-BASE|B-PROPERTY,XR-BASE|B-NONPROPERTY,XR-BASE|B-PROPERTY-STREET-TEXT,XR-TITLE|*"

  ""

)

 

But more directly to your question, I agree with @john.uhden that the (initget)/(getkword) approach is the way to go.  [But his needs some fixing of variable names, some of which have @ prefix in one place but not another.]

Kent Cooper, AIA
0 Likes
Message 4 of 16

Kent1Cooper
Consultant
Consultant

@john.uhden wrote:

....

(setq ans (getkword "\nSelect a topping <Mushrooms>/Peppers/Sausage: "))

....


I suggest doing that line this way:

 

(setq ans (getkword "\nSelect a topping [Mushrooms/Peppers/Sausage] <Mushrooms>: "))

 

Putting the options in square brackets with slash-separators will, in use, show the prompt with the initial capitals bold and blue:

 

Select a topping [Mushrooms/Peppers/Sausage] <Mushrooms>:

 

just as with regular AutoCAD command options, and you can pick one on-screen or use the pull-down approach if you prefer either to typing in an option [which you can still do].

 

 

Kent Cooper, AIA
Message 5 of 16

john.uhden
Mentor
Mentor
@Kent1Cooper
Thank you for pointing out the @ confusion.
I happen to prefix all my subfunctions with @ and I started with that style
but decided I might confuse the lurkers, so I went to remove it but was
obviously sloppy.

John F. Uhden

0 Likes
Message 6 of 16

john.uhden
Mentor
Mentor
Thank you again, @Kent1Cooper. Excellent suggestion.
My brain gets stuck in the 1990s, so I often fail to take advantage of more
modern features.

John F. Uhden

0 Likes
Message 7 of 16

venturini.anthony
Advocate
Advocate

thanks, i think that will help on the timing problem that im having. when i replaced it, i get this message that pops up, and then nothing happens, how can i fix this?

 

venturinianthony_0-1637333295865.png

 

and heres the code now for reference

 

(vl-load-com)

(defun c:fade (/ *error* c_doc c_lyrs)

; localised error function
(defun *error* ( msg )
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
(princ)
);_end_*error*_defun

;initial setups go here
(setq c_doc (vla-get-ActiveDocument (vlax-get-acad-object))
c_lyrs (vla-get-layers c_doc)
);end_setq

;start of altering drawing
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
(vla-startundomark c_doc)
(command "_.layer"
"_tr" 60 "*|*,XR-*"
"_tr" 0 "XR-BASE|B-PROPERTY,XR-BASE|B-NONPROPERTY,XR-BASE|B-PROPERTY-STREET-TEXT,XR-TITLE|*"
)
(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
(princ)
);end_defun

0 Likes
Message 8 of 16

Kent1Cooper
Consultant
Consultant

You're still in the Layer command, because you didn't include the "" Enter to finish it:

(command "_.layer"
  "_tr" 60 "*|*,XR-*"
  "_tr" 0 "XR-BASE|B-PROPERTY,XR-BASE|B-NONPROPERTY,XR-BASE|B-PROPERTY-STREET-TEXT,XR-TITLE|*"

  ""
)

Kent Cooper, AIA
0 Likes
Message 9 of 16

venturini.anthony
Advocate
Advocate

that fixed that issue, but i get this message in the command line, but it end there and nothing happens

 

venturinianthony_0-1637335176440.png

 

0 Likes
Message 10 of 16

Sea-Haven
Mentor
Mentor

Out of the 1990's 

 

(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(setq ans (ah:butts 1 "v"  '("Select a topping" "Mushrooms" "Peppers" "Sausage")))

 

 

SeaHaven_0-1637390885456.png

I think it was Grrr or RLX had a dynode version of same task so would appear on screen as a choice.

0 Likes
Message 11 of 16

Kent1Cooper
Consultant
Consultant

@venturini.anthony wrote:

that fixed that issue, but i get this message in the command line, but it end there and nothing happens

 

venturinianthony_0-1637335176440.png

 


The operational parts of your code [in two posts] end with Layer operations.  What else is supposed to happen?

Kent Cooper, AIA
0 Likes
Message 12 of 16

tinouye42
Explorer
Explorer

Hi, I'm trying to expand on this code but am getting a "no function definition" error. Can someone take a look at let me know what's wrong with my code? Thanks!

0 Likes
Message 13 of 16

ec-cad
Collaborator
Collaborator

Modified your code, basically, removed the C: from your subfuncions.

With a C: prefix, they become something you can call from the Command prompt.

Without the C: prefix they are just another function of the overall function.

 

ECCAD

 

(defun c:Topping ( / ans mush pepp saus)

(defun mush ()
  (princ "\nYou chose mushrooms")
)

(defun pepp ()
  (princ "\nYou chose peppers")
)

(defun saus ()
  (princ "\nYou chose sausage")
)

(princ "\nFunctions loaded")

(initget "Mushrooms Peppers Sausage")
(setq ans (getkword "\nSelect a topping [Mushrooms/Peppers/Sausage] <Mushrooms>: "))
(cond
  ((or (not ans)(= ans "Mushrooms"))(mush)); removed the c:

  ((= ans "Peppers")(pepp)) ; removed the c:

  ((= ans "Sausage")(saus)); removed the c:
)
)

 

0 Likes
Message 14 of 16

tinouye42
Explorer
Explorer

Got it. Thanks for explaining!

0 Likes
Message 15 of 16

Kent1Cooper
Consultant
Consultant

Any time there is repetition of something multiple times, such as the "\nYou chose" portion of the prompts in all those sub-routines, and the fact that all those prompts are defined separately, there's probably a way to do it that contains that repetitive part only once.  And it often means you can eliminate some variables and or sub-routines, as is true in this case:

(defun c:Topping (/ ans)
  (initget "Mushrooms Peppers Sausage")
  (setq ans (getkword "\nSelect a topping [Mushrooms/Peppers/Sausage] <Mushrooms>: "))
  (prompt (strcat "\nYou chose " (cond (ans) ("Mushrooms")) "."))
)

 

Kent Cooper, AIA
0 Likes
Message 16 of 16

Sea-Haven
Mentor
Mentor

Look at message 10 did not post the Multi radio buttons.lsp supports up to about 20+ buttons.

 

(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(setq ans (ah:butts 1 "v"  '("Select a topping" "Mushrooms" "Peppers" "Sausage")))

 

0 Likes