TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: rugaroo on September 26, 2003, 07:21:16 PM
-
Here is the latest and greatest. There are still bugs, and I still have yet to put in layer creation. But here it is...any ideas to improve this?
Just a few notes.
-TEMP and SETBACKS layers must be present.
- You'll notice that after you select the lot lines for a side, and then hit enter, there is an error.
;---internal functions---;
;---layer and linetype checking
;---get setback info - if not stored
(defun GETNEW ()
(initget 7)
(setq FRONTOFF (getreal "\n\nWhat is the Front yard setback: ")
SIDEOFF (getreal "\nWhat is the Side yard setback: ")
REAROFF (getreal "\nWhat is the Rear yard setback: ")
)
(setcfg "AppData/Setbacks/Front" (rtos FRONTOFF))
(setcfg "AppData/Setbacks/Side" (rtos SIDEOFF))
(setcfg "AppData/Setbacks/Rear" (rtos REAROFF))
)
;---get setback info - if stored
(defun GETSTORED ()
(setq FRONTOFF (distof (getcfg "AppData/Setbacks/Front"))
SIDEOFF (distof (getcfg "AppData/Setbacks/Side"))
REAROFF (distof (getcfg "AppData/Setbacks/Rear"))
)
)
;---get users variables
(defun USERVARS ()
(setq USERLAY (getvar "clayer")
USERCMD (getvar "cmdecho")
USERORTH (getvar "orthomode")
USEROSM (getvar "osmode")
USERFILL (getvar "filletrad")
)
)
;---restore users variables
(defun RESTOREUSER ()
(setvar "clayer" USERLAY)
(setvar "cmdecho" USERCMD)
(setvar "orthomode" USERORTH)
(setvar "osmode" USEROSM)
(setvar "filletrad" USERFILL)
(vl-cmdf "undo" "end")
)
;---set program vars
(defun PROGVARS ()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "orthomode" 0)
(setvar "filletrad" 0)
(vl-cmdf "undo" "begin")
)
;---SWALE information
;---set swale variables
;
;---main program
;
(defun C:SB ()
(USERVARS)
(PROGVARS)
(if (or
(= FRONTOFF NIL)
(= SIDEOFF NIL)
(= REAROFF NIL)
)
(GETNEW)
(progn
(setq VALS (strcat "\nCurrent setbacks --> Front <"
(rtos FRONTOFF)
"> / Side <"
(rtos SIDEOFF)
"> / Rear <"
(rtos REAROFF)
">"
)
)
(princ VALS)
)
)
(initget "Y N")
(setq ANS (getkword "\nAre these correct? [Yes/No]: "))
(if (= ANS "N")
(GETNEW)
(GETSTORED)
)
(setq OSP (getpoint "\nPick the center of the lot: "))
(while
(vl-cmdf "offset"
frontoff
(entsel (strcat "\nSelect front lot lines: "))
osp
""
)
(setq front (vlax-ename->vla-object (entlast)))
(vla-put-layer front "temp")
(princ)
)
(while
(vl-cmdf "offset"
sideoff
(entsel (strcat "\Select side lot lines: "))
osp
""
)
(setq side (vlax-ename->vla-object (entlast)))
(vla-put-layer side "temp")
(princ)
)
(while
(vl-cmdf "offset"
rearoff
(entsel (strcat "\nSelect rear lot lines: "))
osp
""
)
(setq rear (vlax-ename->vla-object (entlast)))
(vla-put-layer rear "temp")
(princ)
)
(vl-cmdf "bpoly" OSP "")
(setq BOUND (vlax-ename->vla-object (entlast)))
(vl-cmdf "erase" (ssget "X" '((8 . "temp"))) "")
(vla-put-layer BOUND "SETBACKS")
(vl-cmdf "explode" (entlast))
(princ "\n\nSetbacks created...")
(RESTOREUSER)
(princ)
)
Rug
-
rugaroo, I just went through your thread on Cadalog to see what this was all about. Also downloaded and had a look at the 3 drawings you linked to on Cadalog.
Now, having gone through your code I need to ask before posting any replies: Are you ready for some heavy comments/modifications?
-
Well input is always good, so I guess I will be brave, and say 'Bring it on'...I am going to regret this i bet. All well, I need the practice.
Rug
-
Rug, I don't think you'll regret it, but brace yourself for some intense learning. Stig will blow you away.
-
Good. Of course, I mean no offense with all these comments so if you're easily offended, please do not proceed 8)
On the other hand, you did write on Cadalog that this routine would save you hours of work, so I just think - from the goodness of my heart - that it shouldn't be able to add hours of extra work because of exploding or erasing the wrong line art.
No comments without living up to the comments myself, so hang on and I'll try post some suggestions. My comments in your original code below are prefixed with ;;sm:
;---internal functions---;
;---layer and linetype checking
;---get setback info - if not stored
(defun GETNEW ()
;;sm: initget works for a single call to a GETxxx function
;;sm: SIDEOFF and REAROFF can therefore be nil, zero or negative!
(initget 7)
(setq FRONTOFF (getreal "\n\nWhat is the Front yard setback: ")
SIDEOFF (getreal "\nWhat is the Side yard setback: ")
REAROFF (getreal "\nWhat is the Rear yard setback: ")
)
;;sm: these settings will only be set if the user inputs values
;;sm: however, GETSTORED is called even if no cfg settings exist
(setcfg "AppData/Setbacks/Front" (rtos FRONTOFF))
(setcfg "AppData/Setbacks/Side" (rtos SIDEOFF))
(setcfg "AppData/Setbacks/Rear" (rtos REAROFF))
)
;---get setback info - if stored
(defun GETSTORED ()
;;sm: see rem above. If GETNEW is never called (which is likely to
;;sm: happen) then no cfg settings will exist, and the values will
;;sm: come out as nil.
(setq FRONTOFF (distof (getcfg "AppData/Setbacks/Front"))
SIDEOFF (distof (getcfg "AppData/Setbacks/Side"))
REAROFF (distof (getcfg "AppData/Setbacks/Rear"))
)
)
;---get users variables
(defun USERVARS ()
;;sm: bad case of adding global variables to the environment
(setq USERLAY (getvar "clayer")
USERCMD (getvar "cmdecho")
USERORTH (getvar "orthomode")
USEROSM (getvar "osmode")
USERFILL (getvar "filletrad")
)
)
;---restore users variables
(defun RESTOREUSER ()
;;sm: bad case of relying on global variables. What happens
;;sm: next time you write a routine that makes use of the
;;sm: exact same variables?
(setvar "clayer" USERLAY)
(setvar "cmdecho" USERCMD)
(setvar "orthomode" USERORTH)
(setvar "osmode" USEROSM)
(setvar "filletrad" USERFILL)
(vl-cmdf "undo" "end")
)
;---set program vars
(defun PROGVARS ()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "orthomode" 0)
(setvar "filletrad" 0)
(vl-cmdf "undo" "begin")
)
;---SWALE information
;---set swale variables
;
;---main program
;
(defun C:SB ()
(USERVARS)
(PROGVARS)
;;sm: could simply be written
;;sm: (if (and FRONTOFF SIDEOFF REAROFF)(princ ...)(GETNEW))
;;sm: VALS is not doing a thing .. it's just yet another global(!)
;;sm: variables added to the environment
(if (or
(= FRONTOFF NIL)
(= SIDEOFF NIL)
(= REAROFF NIL)
)
(GETNEW)
(progn
(setq VALS (strcat "\nCurrent setbacks --> Front <"
(rtos FRONTOFF)
"> / Side <"
(rtos SIDEOFF)
"> / Rear <"
(rtos REAROFF)
">"
)
)
(princ VALS)
)
)
(initget "Y N")
(setq ANS (getkword "\nAre these correct? [Yes/No]: "))
(if (= ANS "N")
(GETNEW)
;;sm: GETSTORED has nothing to retrieve if GETNEW has
;;sm: never been called
(GETSTORED)
)
(setq OSP (getpoint "\nPick the center of the lot: "))
(while
(vl-cmdf "offset"
frontoff
;;sm: make the data ready before offsetting them
;;sm: this is where it errors because of nil responses
(entsel (strcat "\nSelect front lot lines: "))
osp
""
)
;;sm: you have no way to ensure that the offset command indeed
;;sm: made a new entity or that the user simply got tired of
;;sm: the command and hit an empty response. In that case, ENTLAST
;;sm: will commit rape on an innocent object prior to this routine.
(setq front (vlax-ename->vla-object (entlast)))
;;sm: you do write that "TEMP" and "SETBACKS" layers have to be present
;;sm: but it doesn't take much to check if they are and make'em if not
(vla-put-layer front "temp")
(princ)
)
;;sm: next two loops the same as above.
(while
(vl-cmdf "offset"
sideoff
(entsel (strcat "\Select side lot lines: "))
osp
""
)
(setq side (vlax-ename->vla-object (entlast)))
(vla-put-layer side "temp")
(princ)
)
(while
(vl-cmdf "offset"
rearoff
(entsel (strcat "\nSelect rear lot lines: "))
osp
""
)
(setq rear (vlax-ename->vla-object (entlast)))
(vla-put-layer rear "temp")
(princ)
)
;;sm: are you sure that OSP is set? Maybe the user hit enter
;;sm: without picking a point
(vl-cmdf "bpoly" OSP "")
;;sm: same as above: there's no check if the last entity is what
;;sm: you expect it to be
(setq BOUND (vlax-ename->vla-object (entlast)))
(vl-cmdf "erase" (ssget "X" '((8 . "temp"))) "")
;;sm: VLA-PUT-LAYER will try to put recently (very recent! :) erased
;;sm: entities on an existing or non-existing layer
(vla-put-layer BOUND "SETBACKS")
;;sm: Please don't explode MY entities! Check if it is your entity
;;sm: before exploding it :)
(vl-cmdf "explode" (entlast))
(princ "\n\nSetbacks created...")
(RESTOREUSER)
(princ)
)
-
As promised, here's a routine that tries to honor the comments made earlier. It's not to be taken as a "this-is-the-only-right-stuff" - only as a suggestion to avoid some specific errors.
Comments in the code take over any further explanation:
(defun C:SB (/ FRONTOFF SIDEOFF REAROFF USERLAY USERCMD
USEROSM USERFILL OSP tmp sset
ent lastent myPrompt *error*)
;; Local error handler. Check the comments at the end of
;; the routine.
(defun *error* (msg)
(if msg (princ (strcat "Rugaroo made an error: " msg)))
;; Reset system variables if the corresponding variables
;; contains data
(foreach var '(("clayer" USERLAY)("cmdecho" USERCMD)
("orthomode" USERORTH)("osmode" USEROSM)
("filletrad" USERFILL)
)
(if (eval (cadr var))
(setvar (car var) (eval (cadr var)))
)
)
(princ)
)
;; There are other ways to deal with this getvar/setvar stuff
;; (like the simple one shown in the local *error* function)
;; but let's just keep what you have. However! There is no
;; need to expose these variables to the environment. Keep
;; them as local variables (declared as local by appearing
;; in the 'local' list after the function name above).
(setq USERLAY (getvar "clayer")
USERCMD (getvar "cmdecho")
USERORTH (getvar "orthomode")
USEROSM (getvar "osmode")
USERFILL (getvar "filletrad")
)
(setvar "cmdecho" 0)
;; OSMODE will wait to be turned off until there's such a need.
;; The user would likely want it on when being prompted of
;; setback distances.
;; (setvar "osmode" 0)
(setvar "orthomode" 0)
(setvar "filletrad" 0)
;; Let's also keep this config stuff, but load it no matter
;; what. That way you have it and can check if it holds valid data.
;; Config data contains strings so DISTOF is a good choice to
;; try and retrieve the values. ATOF returns 0.0 from an empty
;; string, whereas DISTOF returns nil - making easier to test.
(setq FRONTOFF (distof (getcfg "AppData/Setbacks/Front"))
SIDEOFF (distof (getcfg "AppData/Setbacks/Side"))
REAROFF (distof (getcfg "AppData/Setbacks/Rear"))
)
;; For retrieving values I would prefer to prompt with default
;; values. It conforms to the standard GUI of AutoCAD and makes
;; the user feel in control. If no changes are necessary it only
;; takes two keystrokes more to proceed. But, it can be varied
;; in a number of ways, all depending on flavour.
;; Also, I prefer using GETDIST over GETREAL because it allows
;; the user to drag distances on the screen.
;; Lots of things are going on in this little FOREACH thing. I'd
;; be happy to explain it or, if you don't like it, suggest some
;; other method.
(setq myPrompt ": ")
(foreach var '((FRONTOFF . "Front") (SIDEOFF . "Side") (REAROFF . "Rear"))
(if (and (numberp (eval (car var))) (> (eval (car var)) 0.0))
(setq myPrompt (strcat " <" (rtos (eval (car var))) ">: "))
)
(if (null (eval (car var)))
(initget 7)
(initget 6)
)
(if (setq tmp (getdist (strcat "\nSpecify " (cdr var) " yard setback" myPrompt)))
(set (car var) tmp)
)
(setq myPrompt ": ")
)
;; User is done specifying setback distances. Now turn off OSMODE so
;; that the point specified below doesn't fly into outer space.
;; Every single line of code hereafter is dependent on the 3
;; values FRONTOFF, SIDEOFF and REAROFF. Therefore, wrap everything
;; in a condition to ensure that the routine doesn't blow up.
;; It'll be safe to assume that they hold a number or nil by now.
(cond ((and FRONTOFF SIDEOFF REAROFF
(setq OSP (getpoint "\nPick the center of the lot: "))
)
;; OSP is - like the setback distances - essential for further
;; processing. So if the user was too lazy to input a point
;; we won't proceed as it will not pass the COND test.
;; It's now safe to store the values until next time. If
;; you need to save with precision, now will be a good time
;; to check out the users settings of LUPREC and LUNITS in
;; order to determine how to call RTOS.
(setcfg "AppData/Setbacks/Front" (rtos FRONTOFF))
(setcfg "AppData/Setbacks/Side" (rtos SIDEOFF))
(setcfg "AppData/Setbacks/Rear" (rtos REAROFF))
;; The following collects entities BEFORE attempting to
;; offset them. Also, it keeps track of last entities to
;; ensure that the offset command succeeded.
;; The 3 loops below could be wrapped into a single loop like
;; above (when getting offset values). Even better, they could
;; be defined in their own subroutine! But let's take it one
;; after the other for now.
;; Personally, I don't like dealing with vla-objects in the
;; middle of it all, so CHPROP is used to put entities on the
;; temporary layer. I'm not saying it's the right thing to do,
;; but versions before release 2004 do not handle these mixes
;; in a reliable way. Actually there's no reason whatsoever to
;; create a temporary layer because we'll be collecting all
;; new entites in a selection set that can be erased afterwards.
;; Why? Because a layer named "temp" could already be in use,
;; so erasing everything on this layer can be very hazardous
;; to your health and rep if you ever release such a method
;; to the public!!
;; First set - or create and set - layer "temp" (just for fun :)
(command ".LAYER" "Make" "temp" "" "")
;; Then make a selection set to sweep up temporary entities
;; because they'll be erased afterwards
(setq sset (ssadd))
;; The ERRNO trick ensures that the user can exit from the loop
;; simply by giving an empty response. ERRNO will be set to 52
;; if no entity was picked with ENTSEL.
(setvar "ERRNO" 0)
(while (and (setq ent (car (entsel "\nSelect Front lot lines: ")))
(/= (getvar "ERRNO") 52)
)
(setq lastent (entlast))
(command ".OFFSET" FRONTOFF ent OSP "")
(cond ((not (eq lastent (entlast)))
(ssadd (entlast) sset)
(command ".CHPROP" (entlast) "" "Layer" "temp" "")
)
)
)
;; Do the same for SIDEOFF
(setvar "ERRNO" 0)
(while (and (setq ent (car (entsel "\nSelect Side lot lines: ")))
(/= (getvar "ERRNO") 52)
)
(setq lastent (entlast))
(command ".OFFSET" SIDEOFF ent OSP "")
(cond ((not (eq lastent (entlast)))
(ssadd (entlast) sset)
(command ".CHPROP" (entlast) "" "Layer" "temp" "")
)
)
)
;; ... and for REAROFF
(setvar "ERRNO" 0)
(while (and (setq ent (car (entsel "\nSelect Rear lot lines: ")))
(/= (getvar "ERRNO") 52)
)
(setq lastent (entlast))
(vl-cmdf ".OFFSET" REAROFF ent OSP "")
(cond ((not (eq lastent (entlast)))
(ssadd (entlast) sset)
(command ".CHPROP" (entlast) "" "Layer" "temp" "")
)
)
)
;; Create the BPOLY. Save the last entity to check for success
(setq lastent (entlast))
(command ".BPOLY" OSP "")
(cond ((not (eq (entlast) lastent))
;; Yeehawww! BPOLY apparantly succeeded!
;; No need to set or create layer "SETBACKS" until now.
(command ".LAYER" "Make" "SETBACKS" "" "")
;; Now that it's set, use it:
(command ".CHPROP" (entlast) "" "Layer" "SETBACKS" "")
;; Erase temporary entities (again, no "temp" layer
;; was really needed!)
(command ".ERASE" sset "")
;; Explode the setback boundary
(command ".EXPLODE" (entlast))
;; .. and announce the happy event
(princ "\n\nSetbacks created...")
)
(T (princ "\nNo luck today :-("))
)
)
)
(*error* nil)
;; What happened to resetting the systemvariables???!!
;; Because a local error handler was created that resets
;; the variables upon error, we might as well use it to
;; also reset the variables on normal exit. That's why
;; it's called with a simple argument of nil.
;; It even takes care of the silent-exit-princ :-)
)
-
Oops, forgot the "undo" command.
Suggestion: put (command "UNDO" "Begin") early in the routine, and (command "UNDO" "End") just before (princ) in the local error handler.
-
:shock: " (*error* nil) "
Daaaaaaaaammmmmn! Outstanding!
-
Heh Se7en .. nice to see some genuine enthusiasm! :lol:
-
SMadsen -
Please don't take this offensively, but I was trying to keep it very simple...I know that there is a very large amount of stuff in this that I already should be familiar with, but I am not. Like I said I am a beginner. I can not lie though, I am extremely amazed with what you have posted. I am going to try to sit down and tear apart your code now. So give me some time, and I am sure I will have plenty of questions.
Thank you very much,
Rug
BTW -
Command: sb
Specify Front yard setback <20.0000>:
Specify Side yard setback <5.0000>:
Specify Rear yard setback <15.0000>:
Pick the center of the lot:Unknown command "SB". Press F1 for help.
Select Front lot lines:
Select Front lot lines:
Select Side lot lines:
Select Side lot lines:
Select Side lot lines:
Select Rear lot lines:
Select Rear lot lines:
Select Rear lot lines:
Select Rear lot lines:
Unknown command "SB". Press F1 for help.
Setbacks created...
-
Rug, I believe Stig was making it more simple. What I've learned being around Stig for the short period of time that I have is that he likes to keep his code simple. He doesn't do redundant things and will teach you ways to do things you never thought possible. The (*error* nil) for instance. I would've never thought of that and from Se7en's post it seems he wouldn't've either. Sometimes things that don't seem simple really are what make the code simple. As well, some things that seem simple, make the code more complex. Think about the lists. I have a group of strings in a routine that could be simplified if I had understood lists the way Stig explains them here.
Rug, have you figured out how to use the inspect button in vlide? If you use it to step through the code, you'll find where the error is happening and you might be able to figure out why you're having a problem.
-
Daron - I honestly believe what you and 7 have said...what I see is complex to me because i don't know how it really works, or how to use it. That is why I sit down with code people give me, and break it down so I can understand it. And yes I do know how to use the inspect button, but when it comes to figuring out these errors, I am horrible...And as you and the other here know, I do ask a large amount of questions, and I do actually try to figure out how to work things out, although it never works out that easily. :)
Rug
-
Rug, That is exactly what your suposed to do. Sit down and run each line of the code and see what it returns. This might be getting of the subject a bit but one of this things that I rember sitting down with was the "if" statment. I remeber taking it right from the help file and running it over and over, each peice was run seperately and i watched what was returned after each statment. I started on 14 so i didnt have the VLIDE to play with. I've played with stupid functions for hours; Just playing arround. That is how you learn! take a statemtent and run it a dozen times. One of my all time favorite was the "and" function.
Command: (setq a 1.0)
1.0
Command: (and a)
T
Command: (not a)
nil
Command: (if a (alert "the a var is set") (alert "the a var is NOT set"))
nil
Command: (and b)
nil
Command: (not b)
T
Command: (while b)
nil
Command: (if b (alert "the b var is set") (alert "the b var is NOT set"))
nil
Command: (or a b)
T
Command: (eval a)
1.0
Command: (eval b)
nil
Dont get discoruraged by the code. If you know the little stuff about the code, you will be that much better. Hell, I look up functions all the time. After a while the code just reads like text to you, and you just need the help files for rembering what the "not" function does. Stig is actualy teaching you the proper way to used the lisp language.
Stig, Mark and i were talking on the phone talking about some board/PHP crap and he told me about that line.
"John, did you see stig's post?"
"No, what's it on?"
"The one 'Rug' started. You have to look at it, he.... wow! Just look it over and tell me what you see?"
I quickly scrolled over the code and that just poped out at me saying 'HA, bet you never thought of this before did you?!' I must say man that is a great idea.
-
Geez, enough with the back padding already .. every line of code is stolen from somewhere anyway! It's not a sign of clever insight - only a sign of age (and/or lack of a life) :lol:
Rugaroo, there's no better way to learn than to tear apart code and try to understand how it works. Way to go! Along with that, I think it's important also to discard and postpone things that are not about to become obvious before some other stuff is understood. For example, alot of time can be wasted on diving into a complex recursive method if the concept of recursion is not yet fully understood. So, as a beginner, grab what can be used at the moment and just skim the rest, telling yourself that in a few months you will be able to write and maybe even improve on the code that you don't quite grasp today.
Before I forget: the errors come from an extra return in the two LAYER command statements. Delete one "" in each and it should run ok.
I tried to put it all into one routine to make it simple, but this of course has a couple of reverse effects. Getting multiple values like Frontoff, Sideoff and Rearoff - or getting/offsetting entities with different prompts/distances - requires complex structures or repeated code if it has to be contained within the same defun. The natural thing to do is to write utility routines for such cases (or, as I like to call them with a misrepresenting name, subroutines).
The important thing with subroutines is that they have to live their own lifes, so to speak. A good rule of thumb is that you should be able to call a subroutine at the command line without crashes, without adding global variables (unless it is intentionally designed to do so) and without changing the environment in any way.
The subroutines in the original code are dependent on either other subroutines or on global variables. USERVAR/RESTOREUSER relied on global variables. GETSTORED could not function without GETNEW having been called. No independent variables were exchanged between either of them, and if that doesn't lead to hickups it leads to maintainance hell.
Below, I have substituted some of the code with subroutines that get called within the main defun.
Try load it and then call e.g. GetValue from the command line:
Command: (getvalue 4.5 "junk")
Specify junk yard setback <4.5>: 3.0
3.0
No dependence on the main routine, no global variables added, no changes to the environment, - it just returns a simple value.
Also try call offsetObject from the command line:
Command: (setq sset (offsetObject 12.5 (getpoint "Pick it: ") "Sir Lance" nil))
Pick it: pick a point
Select Sir Lance lot lines: pick entity
Select Sir Lance lot lines:
< Selection set: 2a>
Again, no dependency .. it just returns a selection set without caring where it came from or where it'll be used.
Revised code below. Hope it's a bit simpler than the previous.
(defun getValue (val side / prmpt init inquiry)
(if (and (numberp val) (> val 0.0))
;; Value is retrieved from config - it's a number and it's
;; greater than zero, so offer it as default value
;; Set up INITGET 6 to prohibit zero and negative values
(setq prmpt (strcat "Specify " side " yard setback <" (rtos val) ">: ")
init 6
)
;; Value is not retrieved from config - or it's not a number
;; or it's not greater than zero, so don't dare to offer it
;; as default value
;; Set up INITGET 7 to prohibit zero, negative and NIL values
(setq prmpt (strcat "Specify " side " yard setback: ")
init 7
)
)
;; Perform the inquiry with the appropriate filter for input
;; If init is 6 and nil is hit then do nothing but return val
;; as it is. Otherwise, if a value is input then return it.
;; If init is 7 and nil is hit .. well, try again.
(initget init)
(if (setq inquiry (getdist prmpt))
(setq val inquiry)
)
val
)
(defun offsetObject (offdist offpt side ss / ent lastent)
;; If no selection set is supplied then create one that
;; can be returned by the function
(if (not ss)(setq ss (ssadd)))
;; Reset ERRNO as not to get caught in any previous error
;; condition
(setvar "ERRNO" 0)
;; Do yer selection and offsetting stuff
(while (and (setq ent (car (entsel (strcat "\nSelect " side " lot lines: "))))
(/= (getvar "ERRNO") 52)
)
(setq lastent (entlast))
(command ".OFFSET" offdist ent offpt "")
;; Check for new entity creation
(cond ((not (eq lastent (entlast)))
(ssadd (entlast) ss)
)
)
)
;; Return sset
(if (< 0 (sslength ss)) ss)
)
;; Main function
(defun C:SB (/ FRONTOFF SIDEOFF REAROFF USERLAY USERCMD
USEROSM USERFILL OSP tmp sset
ent lastent myPrompt *error*)
;; Local error handler. Check the comments at the end of
;; the routine.
(defun *error* (msg)
(if msg (princ (strcat "Rugaroo made an error: " msg)))
;; Reset system variables if the corresponding variables
;; contains data
(foreach var '(("clayer" USERLAY)("cmdecho" USERCMD)
("orthomode" USERORTH)("osmode" USEROSM)
("filletrad" USERFILL)
)
(if (eval (cadr var))
(setvar (car var) (eval (cadr var)))
)
)
(princ)
)
;; There are other ways to deal with this getvar/setvar stuff
;; (like the simple one shown in the local *error* function)
;; but let's just keep what you have. However! There is no
;; need to expose these variables to the environment. Keep
;; them as local variables (declared as local by appearing
;; in the 'local' list after the function name above).
(setq USERLAY (getvar "clayer")
USERCMD (getvar "cmdecho")
USERORTH (getvar "orthomode")
USEROSM (getvar "osmode")
USERFILL (getvar "filletrad")
)
(setvar "cmdecho" 0)
;; OSMODE will wait to be turned off until there's such a need.
;; The user would likely want it on when being prompted of
;; setback distances.
;; (setvar "osmode" 0)
(setvar "orthomode" 0)
(setvar "filletrad" 0)
;; Let's also keep this config stuff, but load it no matter
;; what. That way you have it and can check if it holds valid data.
;; Config data contains strings so DISTOF is a good choice to
;; try and retrieve the values. ATOF returns 0.0 from an empty
;; string, whereas DISTOF returns nil - making easier to test.
(setq FRONTOFF (distof (getcfg "AppData/Setbacks/Front"))
SIDEOFF (distof (getcfg "AppData/Setbacks/Side"))
REAROFF (distof (getcfg "AppData/Setbacks/Rear"))
)
;; For getting user inputs, see the routine GETVALUE above
(setq FRONTOFF (getValue FRONTOFF "Front")
SIDEOFF (getValue SIDEOFF "Side")
REAROFF (getValue REAROFF "Rear"))
;; User is done specifying setback distances. Now turn off OSMODE so
;; that the point specified below doesn't fly into outer space.
;; Every single line of code hereafter is dependent on the 3
;; values FRONTOFF, SIDEOFF and REAROFF. Therefore, wrap everything
;; in a condition to ensure that the routine doesn't blow up.
;; It'll be safe to assume that they hold a number or nil by now.
(cond ((and FRONTOFF SIDEOFF REAROFF
(setq OSP (getpoint "\nPick the center of the lot: "))
)
;; OSP is - like the setback distances - essential for further
;; processing. So if the user was too lazy to input a point
;; we won't proceed as it will not pass the COND test.
;; It's now safe to store the values until next time. If
;; you need to save with precision, now will be a good time
;; to check out the users settings of LUPREC and LUNITS in
;; order to determine how to call RTOS.
(setcfg "AppData/Setbacks/Front" (rtos FRONTOFF))
(setcfg "AppData/Setbacks/Side" (rtos SIDEOFF))
(setcfg "AppData/Setbacks/Rear" (rtos REAROFF))
;; Temporary layer creation dropped!
;; Call offsetObject to offset lot lines and collect newly
;; created entities. The first call will create a selection
;; set - the next calls will simply add to it.
(setq sset (offsetObject FRONTOFF OSP "Front" nil)
sset (offsetObject SIDEOFF OSP "Side" sset)
sset (offsetObject REAROFF OSP "Rear" sset))
;; Create the BPOLY. Save the last entity to check for success
(setq lastent (entlast))
(command ".BPOLY" OSP "")
(cond ((not (eq (entlast) lastent))
;; Yeehawww! BPOLY apparantly succeeded!
;; No need to set or create layer "SETBACKS" until now.
(command ".LAYER" "Make" "SETBACKS" "")
;; Now that it's set, use it:
(command ".CHPROP" (entlast) "" "Layer" "SETBACKS" "")
;; Erase temporary entities
(command ".ERASE" sset "")
;; Explode the setback boundary
(command ".EXPLODE" (entlast))
;; .. and announce the happy event
(princ "\n\nSetbacks created...")
)
(T (princ "\nNo luck today :-("))
)
)
)
(*error* nil)
;; What happened to resetting the systemvariables???!!
;; Because a local error handler was created that resets
;; the variables upon error, we might as well use it to
;; also reset the variables on normal exit. That's why
;; it's called with a simple argument of nil.
;; It even takes care of the silent-exit-princ :-)
)
-
(*error* nil)
;; What happened to resetting the systemvariables???!!
;; Because a local error handler was created that resets
;; the variables upon error, we might as well use it to
;; also reset the variables on normal exit. That's why
;; it's called with a simple argument of nil.
;; It even takes care of the silent-exit-princ :-)
I must admit Stig, when I first saw this I thought "what the heck is he doing" so in doubt I quickly copied your error function and the other code that was relevant and made a short little program to test it with. Of course it worked like a champ. I have never seen that one before Stig, I might have to borrow that some time. :D
-
.. every line of code is stolen from somewhere anyway!
Mark, borrow away :)
-
"...stolen..." :lol: w00t! You got it stig.
-
Ok...I am gonna need some time to look at this, and see where my questions are going to be...I had some for your last post of code, but I forgot them at home today... I will have something soon though...Thx agn..to all.
Rug
-
Who IS that masked man?
Stig, I'm impressed....and you gotta understand that I'm easily impressed.LOL
Heck, even Se7en and Daron amaze me!
Hi....I'm "The Bear"...a worthless no-account hanger-on who steals code from the brilliant and gives it to the brain-dead. VERY pleased to make your aquaintance......
T-
-
T-Bear, thanks for the kind words.
Se7en and Daron amazes me too at times, but their lisp code .. well hehe J/K!
The pleasure is all mine.
-
Yeah i know! Daron is frickin' awesome at lisp; his code confuses the hell out of me. :lol: (J/K Daron.)
BTW, Welcome abord Bear. There will be no mouse pad chewing here.
-
his code confuses the he77 out of me.
My code confuses me too.
-
Stig-
All I have to say is wow! I finally learned how to add items to a sset. I was having a problem figuring that out. However...I am still lost with a few things...let's see if I can be clear enough here for all of you, and see if we can figure this out. Here is your code with most of my questions, and some comments to see if i understand this:
(defun GETVALUE (VAL SIDE / PRMPT INIT INQUIRY)
(if (and (numberp VAL) (> VAL 0.0)) ;<- If 'val' is a real number and greater than 0, continue
(setq PRMPT
(strcat "Specify " SIDE " yard setback <" (rtos VAL) ">: ")
;<- Prompts for 'side' setbacks, and shows the current setbacks
INIT 6
)
(setq PRMPT (strcat "Specify " SIDE " yard setback: ")
; <- same as above i believe, but I dont reall understand this
INIT 7
)
)
(initget INIT) ; gets the number supllied above
(if (setq INQUIRY (getdist PRMPT)) ; sets 'inquiry' to the distance from 'prmpt'
(setq VAL INQUIRY) ; sets val to distance recieved from last line
)
VAL ; returns val?
)
(defun OFFSETOBJECT (OFFDIST OFFPT SIDE SS / ENT LASTENT)
(if (not SS)
(setq SS (ssadd))
) ; if selection set is not named 'ss' then add items to 'ss'
(setvar "ERRNO" 0) ; beyond lost here
(while
(and (setq ENT (car (entsel (strcat "\nSelect " SIDE " lot lines: "))))
; prompts to select current side lot lines,
; returns entname w/ car set that entity to
; ent and gets errno and continues if errno
; not equal to 52
(/= (getvar "ERRNO") 52) ; no clue
)
(setq LASTENT (entlast)) ; reselects the last entity selected/added
(command ".OFFSET" OFFDIST ENT OFFPT "") ; offsets
(cond ((not (eq LASTENT (entlast))); if entity does not equal last ent, continue
(ssadd (entlast) SS) ; adds new entity to ss
)
)
)
(if (< 0 (sslength SS))
SS
) ; if 0 is less than the # of ents in ss, continue
)
;; Main function
(defun C:SB (/ FRONTOFF SIDEOFF REAROFF USERLAY
USERCMD USEROSM USERFILL OSP TMP
SSET ENT LASTENT MYPROMPT *ERROR*
)
(defun *ERROR* (MSG)
(if MSG
(princ (strcat "Rugaroo made an error: " MSG))
) ; lost again
(foreach VAR '(("clayer" USERLAY)
("cmdecho" USERCMD) ; for each variable, set uservars
("orthomode" USERORTH)
("osmode" USEROSM)
("filletrad" USERFILL)
)
(if (eval (cadr VAR)) ; if each uservar evaluate the 2nd item is present
(setvar (car VAR) (eval (cadr VAR)))
; like doing setvar "clayer" "something", and so on with all uservars in var
)
)
(princ)
)
(setq USERLAY (getvar "clayer")
USERCMD (getvar "cmdecho")
USERORTH (getvar "orthomode")
USEROSM (getvar "osmode")
USERFILL (getvar "filletrad")
)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "filletrad" 0)
(setq FRONTOFF (distof (getcfg "AppData/Setbacks/Front"))
; sets frontoff to a corresponding integer corresponding w/ users lunits
SIDEOFF (distof (getcfg "AppData/Setbacks/Side")) ; same
REAROFF (distof (getcfg "AppData/Setbacks/Rear")) ; same
)
(setq FRONTOFF (GETVALUE FRONTOFF "Front") ; kind of confused here
SIDEOFF (GETVALUE SIDEOFF "Side")
REAROFF (GETVALUE REAROFF "Rear")
)
(cond ((and FRONTOFF
SIDEOFF
REAROFF
(setq OSP (getpoint "\nPick the center of the lot: "))
; as long as f.off, s.off, r.off are present continue, but if not an error?
)
(setcfg "AppData/Setbacks/Front" (rtos FRONTOFF))
; places the setbacks into our config file
(setcfg "AppData/Setbacks/Side" (rtos SIDEOFF))
(setcfg "AppData/Setbacks/Rear" (rtos REAROFF))
(setq SSET (OFFSETOBJECT FRONTOFF OSP "Front" NIL)
; could you explain this a little more possibly?
SSET (OFFSETOBJECT SIDEOFF OSP "Side" SSET)
SSET (OFFSETOBJECT REAROFF OSP "Rear" SSET)
)
(setq LASTENT (entlast)) ; grabs the last entity created/added
(command ".BPOLY" OSP "") ;bpoly from osp
(cond ((not (eq (entlast) LASTENT))
; as long as a bpoly is made and does not equal above lastent, continue
(command ".LAYER" "Make" "SETBACKS" "") ;make out layer
(command ".CHPROP" (entlast) "" "Layer" "SETBACKS" "")
; changes properties of our bpoly
(command ".ERASE" SSET "") ; erases our selection set
(command ".EXPLODE" (entlast)) ;explodes our bpoly
(princ "\n\nSetbacks created...") ;ALL DONE!!!!
)
(t (princ "\nNo luck today :-(")) ;lost
)
)
)
(*ERROR* NIL) ;lost
)
Sorry for the formatting. Now some more questions...Why are you not using cl-cmdf instead of command? I believe it was actually Daron that told me it was much cleaner to use...Now that I come to think about it, that is the only other question I have besides what is in the code. Well how did I do?
Rug[/i]
-
(setq SSET (OFFSETOBJECT FRONTOFF OSP "Front" NIL)
; could you explain this a little more possibly?
SSET (OFFSETOBJECT SIDEOFF OSP "Side" SSET)
SSET (OFFSETOBJECT REAROFF OSP "Rear" SSET)
)
Look at the Offsetobject function. How many arguments (items before /) does it have? Where are those arguments stated in the function and what value is being passed in its place? Instead of writing out the OFFSETOBJECT three different times, you run it three different times, with slightly different controls. Think of the simplicity in that. How many times do you want to write the same code?
I believe it was actually Daron that told me it was much cleaner to use...
Sorry, wrong there. I have NEVER used vl-cmdf in any of my code and have never told anybody to use it. I avoid it as much as possible. I feel the same way of it as I have come to feel about using command. I think Se7en was actually introducing it in his Ninja tutorial as a better cast for the broken leg that is "command".
-
Thx Daron...and yes you were right...It was 7 that actually brought the vl-cmdf function up...But yes I do see what you are saying.
-
My comments with three ;'s
(defun GETVALUE (VAL SIDE / PRMPT INIT INQUIRY)
(if (and (numberp VAL) (> VAL 0.0)) ;<- If 'val' is a real number and greater than 0, continue
;;; ^correct in your comment
(setq PRMPT
(strcat "Specify " SIDE " yard setback <" (rtos VAL) ">: ")
;<- Prompts for 'side' setbacks, and shows the current setbacks
;;; ^correct in your comment
INIT 6
)
(setq PRMPT (strcat "Specify " SIDE " yard setback: ")
; <- same as above i believe, but I dont really understand this
;;; Remember that VAL comes directly from an attempt to retrieve a value
;;; from the configuration. Therefore VAL will be an empty string ("") if
;;; no such value is found - meaning that IF will go here. Not having a
;;; default value to offer, you would like to NOT have the brackets in the
;;; prompt and you would like the user to input a value (hence INITGET of
;;; 7 that will prohibit a null response).
INIT 7
)
)
(initget INIT) ; gets the number supllied above
;;; ^correct in your comment
(if (setq INQUIRY (getdist PRMPT)) ; sets 'inquiry' to the distance from 'prmpt'
;;; ^correct in your comment
(setq VAL INQUIRY) ; sets val to distance recieved from last line
;;; ^correct in your comment - if INQUIRY returns a number,
;;; otherwise VAL is still equal to VAL, i.e. the default value
)
VAL ; returns val?
;;; ^correct in your comment
)
(defun OFFSETOBJECT (OFFDIST OFFPT SIDE SS / ENT LASTENT)
(if (not SS)
(setq SS (ssadd))
) ; if selection set is not named 'ss' then add items to 'ss'
;;; ^not correct in your comment. SSADD without arguments creates an empty
;;; selection set, making it possible to add entities to it later. You might
;;; say that this initializes a selection set ready for use.
(setvar "ERRNO" 0) ; beyond lost here
;;; the sysvar ERRNO does not necessarily get reset after last error. This
;;; means that ERRNO could hold the value 52 from any time during previous
;;; work in the drawing. It's reset here to 0, so that the loop below works.
(while
(and (setq ENT (car (entsel (strcat "\nSelect " SIDE " lot lines: "))))
; prompts to select current side lot lines,
; returns entname w/ car set that entity to
; ent and gets errno and continues if errno
; not equal to 52
;;; ^correct in your comment
(/= (getvar "ERRNO") 52) ; no clue
;;; sysvar ERRNO will be set (automatically by AutoCAD) to 52 if entity
;;; selecting with ENTSEL fails. This gives you a chance to exit the loop
;;; by simply hitting space (or clicking in empty drawing area which should
;;; not happen, but you can play with that particular case :)
)
(setq LASTENT (entlast)) ; reselects the last entity selected/added
;;; No, saves the last entity added
(command ".OFFSET" OFFDIST ENT OFFPT "") ; offsets
;;; ^correct in your comment
(cond ((not (eq LASTENT (entlast))); if entity does not equal last ent, continue
(ssadd (entlast) SS) ; adds new entity to ss
;;; ^correct in both comments
)
)
)
(if (< 0 (sslength SS))
SS
) ; if 0 is less than the # of ents in ss, continue
;;; simply meaning if there are entities in the selection set then return it,
;;; otherwise return nil (if will fail and return nil)
)
;; Main function
(defun C:SB (/ FRONTOFF SIDEOFF REAROFF USERLAY
USERCMD USEROSM USERFILL OSP TMP
SSET ENT LASTENT MYPROMPT *ERROR*
)
(defun *ERROR* (MSG)
(if MSG
(princ (strcat "Rugaroo made an error: " MSG))
) ; lost again
(foreach VAR '(("clayer" USERLAY)
("cmdecho" USERCMD) ; for each variable, set uservars
("orthomode" USERORTH)
("osmode" USEROSM)
("filletrad" USERFILL)
)
(if (eval (cadr VAR)) ; if each uservar evaluate the 2nd item is present
(setvar (car VAR) (eval (cadr VAR)))
; like doing setvar "clayer" "something", and so on with all uservars in var
;;; ^correct. Because variables are provided in a quoted list, they will have
;;; to be "ripped open" to read the value they hold. EVAL does this.
)
)
(princ)
)
(setq USERLAY (getvar "clayer")
USERCMD (getvar "cmdecho")
USERORTH (getvar "orthomode")
USEROSM (getvar "osmode")
USERFILL (getvar "filletrad")
)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "filletrad" 0)
(setq FRONTOFF (distof (getcfg "AppData/Setbacks/Front"))
; sets frontoff to a corresponding integer corresponding w/ users lunits
SIDEOFF (distof (getcfg "AppData/Setbacks/Side")) ; same
REAROFF (distof (getcfg "AppData/Setbacks/Rear")) ; same
)
(setq FRONTOFF (GETVALUE FRONTOFF "Front") ; kind of confused here
;;; As Daron mentioned, look at the GetValue arguments and see what it does.
;;; It simply returns a value based in user input (user's value or default value)
SIDEOFF (GETVALUE SIDEOFF "Side")
REAROFF (GETVALUE REAROFF "Rear")
)
(cond ((and FRONTOFF
SIDEOFF
REAROFF
(setq OSP (getpoint "\nPick the center of the lot: "))
; as long as f.off, s.off, r.off are present continue, but if not an error?
)
;;; ^Exactemento
(setcfg "AppData/Setbacks/Front" (rtos FRONTOFF))
; places the setbacks into our config file
(setcfg "AppData/Setbacks/Side" (rtos SIDEOFF))
(setcfg "AppData/Setbacks/Rear" (rtos REAROFF))
(setq SSET (OFFSETOBJECT FRONTOFF OSP "Front" NIL)
; could you explain this a little more possibly?
;;; I'll leave that to Darons posting
SSET (OFFSETOBJECT SIDEOFF OSP "Side" SSET)
SSET (OFFSETOBJECT REAROFF OSP "Rear" SSET)
)
(setq LASTENT (entlast)) ; grabs the last entity created/added
(command ".BPOLY" OSP "") ;bpoly from osp
(cond ((not (eq (entlast) LASTENT))
; as long as a bpoly is made and does not equal above lastent, continue
(command ".LAYER" "Make" "SETBACKS" "") ;make out layer
(command ".CHPROP" (entlast) "" "Layer" "SETBACKS" "")
; changes properties of our bpoly
(command ".ERASE" SSET "") ; erases our selection set
(command ".EXPLODE" (entlast)) ;explodes our bpoly
(princ "\n\nSetbacks created...") ;ALL DONE!!!!
;;; ^^^^Yup
)
(t (princ "\nNo luck today :-(")) ;lost
;;; If BPOLY did not make a boundary object then announce the sad news.
;;; A condition of T will always be true, so when COND is evaluating
;;; each of its conditions from top to bottom and it stumps into T it will
;;; say, "hey, I take this to be true!" and starts evaluating statements
;;; within the condition.
)
)
)
(*ERROR* NIL) ;lost
;;; Can't explain it better than what I did before. You just have to
;;; make a fresh pot of coffee and stare at it until it reveals itself :)
)
-
(*ERROR* NIL) ;lost
When I started working with lisp, functions with arguments really caused me to scream. I couldn't make sense of them. Let's see if I can help you realize what's happening. First go back to the code where Stig says he'll leave it to my post. We're referring to a set of functions with values that take the place of arguments in the function. I believe Se7en explained them as (Global / Local) variables. These Global variables are the arguments. You have to tell them their value for the function to work. In this case (*error* nil) is setting msg to nil. This will run the command with no error and will set your variables back to their original state. If you type a loaded function containing arguments like this: (offsetobject) you will get something like this:
Error: too few arguments
Why?
-
damn it! I knew that would bite me in the ass! I misused that damn word! :lol: I made a mistake by posting that little section, it was taken out of context and i didnt notice it till Mark pointed it out to me.
...Im sorry! lmao! Let me try to fix this error. Ill explain in a second daron.
-
I knew that would bite me in the ass!
HEYHEYHEYHEYHEYHEYHEYHEYHEYHEY.................
All it takes is ONE! HEYHEYHEYHEYHEY
-
Alright, i screwed up on that damn grafic and im NEVER gonna live it down. *sigh* Im sorry, for confusing you.
The left side of the parens is for the argument and the right side is the local vars
Lets look at Stigs Error function.
(defun *ERROR* (MSG)
(if MSG
(princ (strcat "Rugaroo made an error: " MSG))
) ; lost again
(foreach VAR '(("clayer" USERLAY)
("cmdecho" USERCMD) ; for each variable, set uservars
("orthomode" USERORTH)
("osmode" USEROSM)
("filletrad" USERFILL)
)
...
You'll notice the first statment is an IF statement. Whats its say? (In words)
"If the MSG argument is true, then prompt this, else dont" So you see? If there is a msg, the function will promt "you made an error" otherwise it dosent. Now when he used the "(error nil)" statment, what was the value of the message argument?
Edit: I feel like Charlie Brown trying to kick the football here! I screwed up again, but i think i fixed all the mistakes! If you guys see any more mistakes, let me know so i can go give myself a swirly.
-
It's okay 7, my main point was to help Rug understand that something has to be supplied otherwise you get a too few arguments callback. Even nil is supplying something. I didn't think calling it a global variable was a problem. I just took it for what it's worth and went with it.
-
I know. I just didnt want anyone confused by my mistake. lmao!
-
Thank you guys....I seemed to get a lot more help over here compared to cadalog for some reason...any ways. Now on to the second part of the program that I was wanting to do, the flowlines. Any ideas on where I should start with this?
-
Do you understand the code thusfar?
-
I seemed to get a lot more help over here compared to cadalog for some reason
The reason you get more help here is that this is Mark & Se7en's home-base. Kinda gittin' to be Daron's too.....
At CADalog, there is a lot more "How do I draw a line" & "My toolbar is gone?!?" stuff.....here the main focus is code.
Notice that, so far, my job on the "general CAD" forum is purty easy. Hope it gets REAL busy one of these days......and I'm sure it will.
-
Any ideas on where I should start with this?
(defun questions2answers (answer2-7)
(if (or (= answer2-7 "") (= answer2-7 "Yes"))
(prompt "PseudoCode")
(prompt "Let's make sure you fully understand")
)
)
-
here the main focus is code.
Notice that, so far, my job on the "general CAD" forum is purty easy. Hope it gets REAL busy one of these days......and I'm sure it will.
I hope it does, Bear. We need to promote the site, without getting in everybody's face.
The thing that I find most difficult on Cadalog is that your superiors seemed to think that if they added a product support forum ILO a programming forum, we'd be happy. It just creates a mess. That's why I asked to start the suggestion box and started making suggestions to Mark. Being busy will be good, but if we're not organized at the starting gate, I think we'd fall into the same un-manageable mess we're in over there.
It's been slow for me over there the last couple of days. I haven't seen many questions I could answer.
-
Ok...I think I figured out the error nil...This clears all of the users variable, which is why we do not have the restore user variables....after staring at this, and removing all of the comments, that is the only thing that could make sense. And I can prove it by just using the layer creation as an example...when you create layers through the prompt, it sets your 'current' layer to the layer you create, unless you set your layer to another....so either i am way off or at least part way there...which is it?
-
I think you've got it! So, I answered your question above. If you understand functions with arguments, what prompt should you get and what should you do. Think in the order in which things should be done, programatically. BTW, Stig's also really good with math and most likely can help you get the radii you were asking about with that.
-
(defun questions2answers (answer2-7)
(if (or (= answer2-7 "") (= answer2-7 "Yes"))
(prompt "PseudoCode")
(prompt "Let's make sure you fully understand")
)
)
This is what got me thinking....Just take what is given, and you have your 'pseudocode', but when you take the time to spell everything out, you are making sure that you fully understand. Geesh....my brain hurts now lol. Here is what I am attempting to add in to create my swales/flowlines. I am going to make this its own independent function which will be called from the end of the setbacks creation process. Here is a rough 'skectch' to start and then some questions.
1. Get side and rear lotlines from sset and add them to a new selection set called ssetswale.
2. Once each item is selected, offset those a fix distance away. 2' from sides and 10' from rears.
3. After offsetting the corresponding lines, changing layer to swale (Actually an easy part there), and filleting each of the objects within our ssetswale with a hard coded radius of 5'.[/list:u]
Now I know this is a really rough idea, but we all need to start somewhere right? I don't believe anyone really said as to why Stig was using command as compared to vl-cmdf. I am going to take a guess here, and say that he is trying to eliminate the combination of VisLISP with regular old LISP. If that is the reason, I can understand keeping it all in one
'format', but other than that I wouldn't truly know. Anyone have any ideas here?
Rug
-
Because Stig IS "The Lisper's Apple" and as such he's entitled to program any way he see's fit. If you need help understanding that, go to www.vbdesign.net/expresso and look for his signature, then think about it for a little bit.
As far as the pseudo code goes, take each idea and try to create a function for it. If it seems like it can be broken down into more modular functions, work on it. Post code as you go.
To understand selection sets, go to http://www.afralisp.com and do a search on selection sets. Really good tutorials.
-
Looked at the selection set tutorials, but they show nothing on how to add ceratin entities to two entirely different ssets at the same time. As far as the rest of my idea goes, the layer changing and and offseting will be no problem. Like for the rear lot lnes, I could follow what Stig was doing for the other offsets.
(defun offsetrear (offpt side ss / ent lastent)
(if (not ssrear)
(setq ssrear (ssadd))
)
(setvar "ERRNO" 0)
(while
(setq lastent (entlast))
(command ".OFFSET" "10" ent offpt "")
(cond
((not (eq lastent (entlast)))
(ssadd (entlast) ssrear)
)
)
)
(if (< 0 (sslength ssrear))
ssrear
)
)
But I am unsure of how to get the items that were selected for the isdes and rears to add them to two other ssets along with the original sset that Stig had created.
EDIT: Formatting
-
I am going to take a guess here, and say that he is trying to eliminate the combination of VisLISP with regular old LISP
Not quite. I don't like to mix Lisp and ActiveX if it can be avoided (too many hickups when doing that, at least before r2004) but VL-CMDF is not an ActiveX command. It's a COMMAND function with an improved error handling.
I guess it's due to pure laziness when trying to debug a function where a command goes wrong. When there's an error in a COMMAND, it bombs and continue the command in AutoCAD, whereas VL-CMDF bombs out (depending on the situation, though) and terminates the command in AutoCAD. By going back to AutoCAD and see where COMMAND left you it's rather easy to get a hint of what went wrong.
Try make a faulty COMMAND sequence and check it out. Here's one
(defun C:ARCIRC_C ()
(command "ARC" (setq pt (getpoint "\nArc start point: ")))
(command "CIRCLE" pt 2.0)
)
Command: arcirc_c
Arc start point:
2D point or option keyword required. <-- invokes VLIDE here
Function cancelled; reset after error <-- resetting in VLIDE
Specify second point of arc or [Center/End]: <-- back to AutoCAD
When it errors, at least it's obvious that it didn't finish the ARC command and something went wrong after specifying the first point.
With VL-CMDF it can be a little more difficult.
(defun C:ARCIRC_F ()
(vl-cmdf "ARC" (setq pt (getpoint "\nArc start point: ")))
(vl-cmdf "CIRCLE" pt 2.0)
)
Command: arcirc_f
Arc start point:
2D point or option keyword required.
Invalid 2D point.
nil
Specify end point of arc: *Invalid*
Command:
That an error occurred is obvious, but where? It doesn't even jump back into VLIDE but continues in AutoCAD with a fresh Command prompt. A backtrace tells you nothing.
Of course, the error can easily be found by stepping through the stuff, but as said, I'm too lazy and want an instant bug to crawl out.
When the code is bug free and ready, I don't really care which command is used. That said, there ARE good uses where you deliberately want to proceed with a routine even though an error occurred - which is why VL-CMDF was written in the first place, I guess.
-
there ARE good uses where you deliberately want to proceed with a routine even though an error occurred
THAT^ is why I've never used vl-cmdf in any routine. I have never realized the need to continue a function if somewhere in the middle it crashed out. Must be my low level of coding knowledge.
-
Well I think it all boils down to proper error trapping/checking. It's not a matter of which one to use, COMMAND or CMDF, it's the amount of error checking you have before/after the function. I use both functions for apps that I write for myself because I know what is going on in the program, I do not use them for customers. I tend to use functions like the one below to make sure I can control all user input. Maybe it's overkill, but it's what I like to use.
(defun MST-GetString (msg / s)
(if
(and
(= (type msg) 'STR)
(not
(vl-catch-all-error-p
(setq s (vl-catch-all-apply 'getstring (list T msg)))
)
); not
)
(strcase s)
); if
); defun
Check out these two functions Daron.
(defun dr2 (/ p1 p2 switch kwd)
(if
(not
(vl-cmdf "line"
(setq p1 (getpoint "\nPoint 1: "))
(setq p2 (getpoint "\nPoint 2: "))
"")
); not
(progn
(setq switch 1)
(alert "cndf failed")
)
(vl-cmdf "circle" p1 p2)
)
(if switch
(progn
(initget 1 "Yes No")
(setq kwd (getkword "\nContinue with program ? (Y/N): "))
(cond
((= kwd "Yes")
(alert "you said yes")
)
((= kwd "No") (exit))
)
)
)
)
(defun dr3 (/ p1 p2 switch kwd)
(if
(not
(command "line"
(setq p1 (getpoint "\nPoint 1: "))
(setq p2 (getpoint "\nPoint 2: "))
""
)
)
(progn
(setq switch 1)
(alert "cndf failed")
)
(command "circle" p1 p2)
)
(if switch
(progn
(initget 1 "Yes No")
(setq kwd (getkword "\nContinue with program ? (Y/N): "))
(cond
((= kwd "Yes")
(alert "you said yes")
)
((= kwd "No") (exit))
)
)
)
)
P.S. I hope I'm not interrupting your lessons Stig! If so just tell me to buzz off. :D
-
Thanks Mark - you pointed out the most important thing about VL-CMDF (which I naturally forgot to tell). VL-CMDF returns T on success and nil on failure.
That's a very nice example showing exactly how handy that feature is.
-
That makes sense then...Now I will just need to figure out which areas would be good to use the vl-cmdf for me, and where not too. Well, I didn't see any answers to my post regarding the multiple selection sets, so I am going to post what I had and ask a few other questions to clerify things.
(defun offsetrear (offpt side ss / ent lastent)
(if (not ssrear)
(setq ssrear (ssadd))
)
(setvar "ERRNO" 0)
(while
(setq lastent (entlast))
(command ".OFFSET" "10" ent offpt "")
(cond
((not (eq lastent (entlast)))
(ssadd (entlast) ssrear)
)
)
)
(if (< 0 (sslength ssrear))
ssrear
)
)
This is exactly the same as Stig's original offset function, but it is for offseting rear lot lines for the use of building the lot flowlines. Now the major problem, is that I don't want to have the user going through, and selecting lot lines too many times. So if it is at all possible, I would like to add the rear and side yard lot lines to two other selection sets, including the original. Is that even possible??? I know that I could add all of the items to multiple selection sets by doing something like:
(defun offsetrear (offpt side ss / ent lastent)
(if (not ssrear)
(setq ssrear (ssadd))
)
(setvar "ERRNO" 0)
(while
(setq lastent (entlast))
(command ".OFFSET" "10" ent offpt "")
(cond
((not (eq lastent (entlast)))
(ssadd (entlast) ssrear)
[b](ssadd (entlast) ssside)[/b]
)
)
)
[b](if (< 0 (sslength ssrear)
(< 0 (sslength ssside)
))
ssrear
ssside
)[/b]
)
Now I believe that would work...I have yet to have the chance to test it out. With that in play, I am able to add all of the objects that the user selects to two entirely different selection sset's, but that does not give me any so called filtering for the side and rear lot lines. Now if I can get the lot lines from these new ssets that I want to create, then I should be able to go through and fillet each of the entities within, and finally break the ents by using polar a bit...correct me if I am wrong, or try to point me in a better direction if you see one.
Rug
-
rug,
it has been a few days and no one has posted so I hope you don't mind.
I was playing with your routine and LEARNING a lot...
I added a few items trying to figure things out & working on the swale.
I added the beginings of the swale creation but also got stuck,
It would seem that bpoly would make it easy to create a rectangle of the swale area but you would still have the radius to deal with as well as the front line of the swale to erase.
I can't see a way to creatre the swale lines without the end points. :(
Code added by me is marked with ;; CAB
(defun GETVALUE (VAL SIDE / PRMPT INIT INQUIRY)
(if (and (numberp VAL) (> VAL 0.0))
;<- If 'val' is a real number and greater than 0, continue
(setq PRMPT
(strcat "Specify " SIDE " yard setback <" (rtos VAL) ">: ")
INIT 6
)
(setq PRMPT (strcat "Specify " SIDE " yard setback: ")
INIT 7
)
)
(initget INIT) ; gets the number supplied above
(if (setq INQUIRY (getdist PRMPT))
; sets 'inquiry' to the distance from 'prmpt'
(setq VAL INQUIRY) ; sets val to distance recieved from last line
;;; otherwise VAL is still equal to VAL, i.e. the default value
)
VAL ; returns val
)
(defun OFFSETOBJECT (OFFDIST OFFPT SIDE SS / ENT LASTENT)
(if (not SS)
(setq SS (ssadd)); creates an empty selection set
)
(if (not ssswale)
(setq ssswale (ssadd)); creates an empty selection set
)
(setvar "ERRNO" 0) ; reset to 0, so that the loop below works.
(while
(and (setq ENT (car (entsel (strcat "\nSelect " SIDE " lot lines: "))))
; prompts to select current side lot lines,
; returns entname w/ car set that entity to
; ent and gets errno and continues if errno
; not equal to 52
(/= (getvar "ERRNO") 52)
;;; sysvar ERRNO will be set (automatically by AutoCAD) to 52 if entity
;;; selecting with ENTSEL fails. This gives you a chance to exit the loop
;;; by simply hitting space (or clicking in empty drawing area which should
;;; not happen, but you can play with that particular case :)
)
(setq LASTENT (entlast)) ;;; saves the last entity added
;;VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV CAB
;; Create swale lines & save in selection set
(cond
((= SIDE "Rear") (command ".OFFSET" 10 ENT OFFPT "") ; offsets
)
((= SIDE "Side") (command ".OFFSET" 2 ENT OFFPT "") ; offsets
)
((= SIDE "Front") (command ".OFFSET" 2 ENT OFFPT "") ; offsets
)
)
(cond ((not (eq LASTENT (entlast))) ; if entity does not equal last ent, continue
(ssadd (entlast) ssswale) ; adds new entity to ssswale
(command ".CHPROP" (entlast) "" "Layer" "SWALE" "") ; changes properties of last entity
)
)
;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ CAB
(command ".OFFSET" OFFDIST ENT OFFPT "") ; offsets
(cond ((not (eq LASTENT (entlast))) ; if entity does not equal last ent, continue
(ssadd (entlast) SS) ; adds new entity to ss
)
)
)
;;; if there are entities in the selection set then return it,
;;; otherwise return nil (if will fail and return nil)
(if (< 0 (sslength SS))
SS
)
)
;;**********************************************************
;; Main function
;;**********************************************************
(defun C:SB (/ FRONTOFF SIDEOFF REAROFF USERLAY
USERCMD USEROSM USERFILL OSP TMP
SSET ENT LASTENT MYPROMPT *ERROR* tmpval ssswale
)
(defun *ERROR* (MSG)
(if MSG ; only display a message if MSG is NOT nil
(princ (strcat "Rugaroo made an error: " MSG))
)
(foreach VAR '(("clayer" USERLAY)
("cmdecho" USERCMD)
("orthomode" USERORTH)
("osmode" USEROSM)
("filletrad" USERFILL)
)
(if (eval (cadr VAR))
; if each uservar evaluate the 2nd item is present
(setvar (car VAR) (eval (cadr VAR)))
; like doing setvar "clayer" "something", and so on with all uservars in var
;;; ^correct. Because variables are provided in a quoted list, they will have
;;; to be "ripped open" to read the value they hold. EVAL does this.
)
)
(princ)
)
(setq USERLAY (getvar "clayer")
USERCMD (getvar "cmdecho")
USERORTH (getvar "orthomode")
USEROSM (getvar "osmode")
USERFILL (getvar "filletrad")
)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "filletrad" 0)
;;VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV CAB
;; added code to test data from acadcfg file in case it is missing
(setq FRONTOFF (If (setq tmpval (getcfg "AppData/Setbacks/Front"))
(distof tmpval)
25 ; default value if not in acadcfg file
)
SIDEOFF (If (setq tmpval (getcfg "AppData/Setbacks/Side"))
(distof tmpval)
7
)
REAROFF (If (setq tmpval (getcfg "AppData/Setbacks/Rear"))
(distof tmpval)
20
)
)
;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ CAB
(setq FRONTOFF (GETVALUE FRONTOFF "Front") ; go get front offset value
SIDEOFF (GETVALUE SIDEOFF "Side")
REAROFF (GETVALUE REAROFF "Rear")
)
(command ".LAYER" "Make" "SWALE" "") ;make Swale layer current CAB
(command "undo" "begin") ;; CAB
(cond ((and FRONTOFF
SIDEOFF
REAROFF
(setq OSP (getpoint "\nPick the center of the lot: "))
; as long as f.off, s.off, r.off are present continue, but if not an error?
)
;; save the setbacks into our config file
(setcfg "AppData/Setbacks/Front" (rtos FRONTOFF))
(setcfg "AppData/Setbacks/Side" (rtos SIDEOFF))
(setcfg "AppData/Setbacks/Rear" (rtos REAROFF))
(setvar "osmode" 0) ;; CAB turn off so it wont interfear ?
;; next let user pick property lines
(setq SSET (OFFSETOBJECT FRONTOFF OSP "Front" NIL)
SSET (OFFSETOBJECT SIDEOFF OSP "Side" SSET)
SSET (OFFSETOBJECT REAROFF OSP "Rear" SSET)
)
(setq LASTENT (entlast)) ; grabs the last entity created/added
(command ".BPOLY" OSP "") ;bpoly from osp
(cond ((not (eq (entlast) LASTENT))
; as long as a bpoly is made and does not equal above lastent, continue
(command ".LAYER" "Make" "SETBACKS" "") ;make out layer
(command ".CHPROP" (entlast) "" "Layer" "SETBACKS" "") ; changes properties of our bpoly
(command ".ERASE" SSET "") ; erases our selection set
(command ".EXPLODE" (entlast)) ;explodes our bpoly
(princ "\n\nSetbacks created...") ;ALL DONE!!!!
)
(t (princ "\nNo luck today :-(")) ; error, failed to create setbacks
)
)
)
(command "undo" "end") ;; CAB
(*ERROR* NIL) ; call to error routine with nil so no message is displayed but uaer variables are saved
) ; end defun main
-
Another question??
Why are the subroutines added at the begining?
Wouldn't it read easer if they were after the
(C:main ()
....code
) ; end main
(defun subroutines
)
Just curious..
-
Guess I was logged out...
Last two post..
CAB
-
Another question??
Why are the subroutines added at the begining?
Wouldn't it read easer if they were after the
(C:main ()
....code
) ; end main
(defun subroutines
)
Just curious..
It's user prefence I suppose, I like my subr's on the top. :D
-
...and with that preference Mark, you've talked a few others of us to do likewise.
-
In many other languages, sequence of subroutines are essential (either that or specifying directives that forces a compiler to load in other sequences).
Because the main routine - in most cases the C: routine in AutoLISP - is just a function that connects the bits and pieces of the real work horses, it falls natural for many to put it where it should be put in other languages: at the end.
I mostly find it logical to put it at the bottom but AutoLISP loads everything at once so, as Mark points out, it's a matter of flavor.
-
Thanks Guys for the explanation...
CAB
-
CAB -
I looked through what you had, and I am glad that I am not the only one getting confused on how to handle this.
To do the fillet of the swale objects, could we possibly try doing something like getting the first entity in our ssswale set (entity 0), and then do something like a foreach entity in ssswale, setvar filletrad 5, setq swaleent1 entity 0, then setq swaleentX with 1+ for each entity in the list....is this making sense?
Rug