Code Red > AutoLISP (Vanilla / Visual)
Setbacks Creator
rugaroo:
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.
--- Code: --- ;---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)
)
--- End code ---
Rug
SMadsen:
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?
rugaroo:
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
daron:
Rug, I don't think you'll regret it, but brace yourself for some intense learning. Stig will blow you away.
SMadsen:
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:
--- Code: --- ;---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)
)
--- End code ---
Navigation
[0] Message Index
[#] Next page
Go to full version