Author Topic: Setbacks Creator  (Read 22473 times)

0 Members and 1 Guest are viewing this topic.

rugaroo

  • Bull Frog
  • Posts: 378
  • The Other CAD Guy
Setbacks Creator
« 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.

Code: [Select]
              ;---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
LDD06-09 | C3D 04-19 | Infraworks 360 | VS2012-VS2017

SMadsen

  • Guest
Setbacks Creator
« Reply #1 on: September 29, 2003, 11:04:21 AM »
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

  • Bull Frog
  • Posts: 378
  • The Other CAD Guy
Setbacks Creator
« Reply #2 on: September 29, 2003, 11:21:29 AM »
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
LDD06-09 | C3D 04-19 | Infraworks 360 | VS2012-VS2017

daron

  • Guest
Setbacks Creator
« Reply #3 on: September 29, 2003, 11:38:22 AM »
Rug, I don't think you'll regret it, but brace yourself for some intense learning. Stig will blow you away.

SMadsen

  • Guest
Setbacks Creator
« Reply #4 on: September 29, 2003, 11:39:38 AM »
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: [Select]
                   ;---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)
)

SMadsen

  • Guest
Setbacks Creator
« Reply #5 on: September 29, 2003, 02:28:11 PM »
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:

Code: [Select]
(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 :-)
)

SMadsen

  • Guest
Setbacks Creator
« Reply #6 on: September 29, 2003, 02:37:38 PM »
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.

JohnK

  • Administrator
  • Seagull
  • Posts: 10170
Setbacks Creator
« Reply #7 on: September 29, 2003, 04:38:51 PM »
:shock:  " (*error* nil) "

Daaaaaaaaammmmmn! Outstanding!
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

SMadsen

  • Guest
Setbacks Creator
« Reply #8 on: September 29, 2003, 06:19:56 PM »
Heh Se7en .. nice to see some genuine enthusiasm!   :lol:

rugaroo

  • Bull Frog
  • Posts: 378
  • The Other CAD Guy
Setbacks Creator
« Reply #9 on: September 29, 2003, 07:35:17 PM »
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...
LDD06-09 | C3D 04-19 | Infraworks 360 | VS2012-VS2017

daron

  • Guest
Setbacks Creator
« Reply #10 on: September 29, 2003, 07:52:09 PM »
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.

rugaroo

  • Bull Frog
  • Posts: 378
  • The Other CAD Guy
Setbacks Creator
« Reply #11 on: September 29, 2003, 08:00:18 PM »
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
LDD06-09 | C3D 04-19 | Infraworks 360 | VS2012-VS2017

JohnK

  • Administrator
  • Seagull
  • Posts: 10170
Setbacks Creator
« Reply #12 on: September 29, 2003, 09:40:38 PM »
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.
Quote
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.
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

SMadsen

  • Guest
Setbacks Creator
« Reply #13 on: September 30, 2003, 07:51:53 AM »
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.

Code: [Select]
(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 :-)
)

Mark

  • Custom Title
  • Seagull
  • Posts: 28725
Setbacks Creator
« Reply #14 on: September 30, 2003, 07:59:19 AM »
Code: [Select]
(*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
TheSwamp.org  (serving the CAD community since 2003)