Author Topic: Area Calcs (feedback)  (Read 3408 times)

0 Members and 1 Guest are viewing this topic.

DanB

  • Bull Frog
  • Posts: 367
Area Calcs (feedback)
« on: February 02, 2006, 01:00:32 PM »
Myself and a co-worker "dabble" in LISP writing whenever we get a spare minute and have received alot of advice and guidance here at the Swamp. I am posting the code below in hopes if getting some constructive criticism (sp?) on our writing. I know there are numerous ways to achieve any given goal but again we are looking for any thoughts/ideas/suggestions on what we have written below. The routine is more for practice but does serve a useful purpose. Be kind...

Thanks,
Dan

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;        ** Error Trap **           ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun myerror (s)                   
  (if (/= s "Function cancelled")
   (princ (strcat "\nError: " s))
  )
  (setvar "cmdecho" oldecho)
  (setq area51 0)
  (setq *error* olderr)           
 (princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;      Area Calculator              ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun areacalc ()
  (command "area" "o" ent)
  (command "change" ent "" "properties" "color" caam:ncolor "")
  (setq ent-area (getvar "area"))
  (setq area-feet (rtos ent-area 2 2))
  (setq area-acre (rtos (/ ent-area 43560) 2 2))
  (setq oldarea area51)
  (setq oldarea-feet (rtos oldarea 2 2))
  (setq oldarea-acre (rtos (/ oldarea 43560) 2 2 ))
  (setq area51 (+ ent-area area51))
  (setq area51-feet (rtos area51 2 2))
  (setq area51-acre (rtos (/ area51 43560) 2 2))

  (if (= oldarea 0)
   (progn
    (prompt (strcat "\nArea Total: < " area51-feet " sq. ft. >" ))
    (prompt (strcat "\nArea Total: < " area51-acre " acres >" ))
   ) ; end progn
   (progn
    (prompt (strcat "\nTotal: " oldarea-feet " + " area-feet " = < " area51-feet " sq. ft. >" ))
    (prompt (strcat "\nTotal: " oldarea-acre " + " area-acre " = < " area51-acre " acres >" ))
   ) ; end progn
  ) ; end if


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;     Place Text in Drawing         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun placetext ()
  (setq pt1 (getpoint "\nPick Location... "))
  (setq pty (+ (+ txtsize (* txtsize 0.667)) (cadr pt1)))
  (setq pt2 (list (car pt1) pty (caddr pt1)))
  (command "text" pt1 "0" (strcat area51-acre " ACRES"))
  (command "text" pt2 "0" (strcat area51-feet " SQ FT"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                 ;;
;;  Calculates TOTAL Areas from Selected Entities                  ;;
;;                                                                 ;;
;;  By Dan B and Jeff K                                       ;;
;;  January 2006                                                   ;;
;;                                                                 ;;
;;    THIS PROGRAM PROVIDED "AS IS" AND WITH ALL FAULTS,           ;;
;;    AND DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM       ;;
;;    WILL BE UNINTERRUPTED OR ERROR FREE.                         ;;
;;                                                                 ;;
;;  TYPE "AM" to Begin                                             ;;
;;                                                                 ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:am (/ oldecho txtstyle txtsize dcolor answr ent ent-area area-feet area-acre
                       oldarea oldarea-feet oldarea-acre area51 area51-feet area51-acre answr2 pt1 pt2 pty)

  (setq olderr  *error*
        *error* myerror)
  (setq oldecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq txtstyle (tblsearch "style" (getvar "textstyle")))
  (setq txtsize (cdr (cadddr txtstyle)))
  (setq area51 0)
 
  (if (= caam:ncolor nil) 
   (setq caam:ncolor 3)
  )
   
  (setq dcolor (itoa caam:ncolor))
   (cond
     ((= dcolor "1")(setq dcolor "1 (Red)"))
     ((= dcolor "2")(setq dcolor "2 (Yellow)"))
     ((= dcolor "3")(setq dcolor "3 (Green)"))     
     ((= dcolor "4")(setq dcolor "4 (Cyan)"))
     ((= dcolor "5")(setq dcolor "5 (Blue)"))
     ((= dcolor "6")(setq dcolor "6 (Magenta)"))
     ((= dcolor "7")(setq dcolor "7 (White)"))
     (T (setq dcolor dcolor))
   ) 
                           
  (initget 0 "Yes No")
  (setq answr (getkword (strcat "Change Current Selection Color? [" dcolor "]  [Yes/<No>] ")))
   (if (= answr "Yes")
    (setq caam:ncolor (acad_colordlg 3 nil))
   )
   
  (while ; while #1
    (/= (getvar "errno") 52)
        (setvar "errno" 0)
        (setq ent (car (entsel)))
        (cond
          ((= (getvar "errno") 52) T)
          ((null ent)
           (prompt "\nNothing selected. ") 
          )
          ((= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
           (areacalc)
           T)
          ((= (cdr (assoc 0 (entget ent))) "CIRCLE")
           (areacalc)
           T)
          ((= (cdr (assoc 0 (entget ent))) "HATCH")
           (areacalc)
           T)
          ((= (cdr (assoc 0 (entget ent))) "ELLIPSE")
           (areacalc)
           T)
          ((= (cdr (assoc 0 (entget ent))) "REGION")
           (areacalc)
           T)
          ((= (cdr (assoc 0 (entget ent))) "SPLINE")
           (areacalc)
           T)
          (T  (prompt "\nNot a Valid Selection"))
        ) ; end cond       
  ) ; end while #1
     
  (initget 0 "Yes No")
  (setq answr2 (getkword (strcat "Place Text in Drawing?  [Yes/<No>] ")))
   (cond
    ((and (= answr2 "Yes")(= txtsize 0))
      (setq txtsize (getreal "\nEnter Text Height: "))
      (command "STYLE" "AREA" "SIMPLEX" txtsize "1" "0" "" "" "")
      (placetext)
    ) ; end cond 1 
    ((and (= answr2 "Yes")(> txtsize 0))
     (placetext)
    ) ; end cond2
    (T)
   ) ; end cond all 
       
 (setvar "cmdecho" oldecho)
 (princ)
)


nivuahc

  • Guest
Re: Area Calcs (feedback)
« Reply #1 on: February 02, 2006, 01:44:00 PM »
Okay, I just tried it out and here's some suggestions (I'll leave code improvement to those more suited to it than I). Please keep in mind that these are my opinions only, so take that for what it's worth.

First out of the box, great job. Nifty little routine. Does just what I expected it would.

Second, too many prompts and not enough comments for my tastes. :)

Consider the user experience. How easy is this routine to use? For you, it's pretty straight-forward. What about someone who wasn't involved in the development? Is it intuitive enough for someone who clicks a toolbar button just to see what it does to be able to use it? And if someone has to use this routine more than twice in a 5 minute time frame, they'll get tired of answering those same questions each time.

Consider your experience. If you dabble in LISP (a good thing, IMO) you will, no doubt, write more than just this routine. And you will, no doubt, still have this one somewhere a year or two down the road. As a person who dabbles (just like me!) it's very easy to forget why you did something the way you did it when you did it, especially if what you did was done a long time ago. :D

Cooments are your friend. You'll find that you'll learn more just from commenting your code. Explain what each portion does and how it does it. You'll find that, when you take that approach, your code will improve as you write it. Because things that don't seem obvious when staring at a screen full of code suddenly seem much clearer when you've got a running reference right there with it.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Area Calcs (feedback)
« Reply #2 on: February 02, 2006, 02:51:36 PM »
Here are some coding changes I would make.
Mainly localizing the subroutines & variables.
If you use "command" place a dot in front of the command item so it doesn't get hijacked.
Try to keep subroutine variables separate, not always easy.

All in all a good start.

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                 ;;
;;  Calculates TOTAL Areas from Selected Entities                  ;;
;;                                                                 ;;
;;  By Dan B and Jeff K                                            ;;
;;  January 2006                                                   ;;
;;                                                                 ;;
;;    THIS PROGRAM PROVIDED "AS IS" AND WITH ALL FAULTS,           ;;
;;    AND DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM       ;;
;;    WILL BE UNINTERRUPTED OR ERROR FREE.                         ;;
;;                                                                 ;;
;;  TYPE "AM" to Begin                                             ;;
;;                                                                 ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:am (/ *error* answr answr2 area51-acre area51-feet dcolor ent myerror oldecho olderr pt1 txtsize txtstyle
             $newarea tarea areacalc
            )

  ;;  global variables
  ;;   caam:ncolor  user selected color

  ;;=================================
  ;;      Sub Routines           
  ;;=================================

  ;;        ** Error Trap **       
  (defun *error* (s)
    (if (/= s "Function cancelled")
      (princ (strcat "\nError: " s))
    )
    (setvar "cmdecho" oldecho)
    (princ)
  )


  ;;=================================
  ;;      Area Calculator           
  ;;=================================
  (defun areacalc (ent area51 / area-acre area-feet area51-acre area51-feet ent-area oldarea-acre oldarea-feet
                  )
    (command ".area" "o" ent)
    (command ".change" ent "" "properties" "color" caam:ncolor "")
    (setq ent-area (getvar "area"))
    (setq area-feet (rtos ent-area 2 2))
    (setq area-acre (rtos (/ ent-area 43560) 2 2))

    (if (zerop area51) ; first time through
      (progn
        (prompt (strcat (strcat "\nArea Total: < " area-feet " sq. ft. >")
                        (strcat "\nArea Total: < " area-acre " acres >")
                )
        )
        (list area-feet area-acre ent-area) ; return the area $|$|n
      )
      (progn
        (setq oldarea-feet (rtos area51 2 2))
        (setq oldarea-acre (rtos (/ area51 43560) 2 2))

        (setq area51 (+ ent-area area51)) ; new total
        (setq area51-feet (rtos area51 2 2))
        (setq area51-acre (rtos (/ area51 43560) 2 2))

        (prompt
          (strcat
            (strcat "\nTotal: " oldarea-feet " + " area-feet " = < " area51-feet " sq. ft. >")
            (strcat "\nTotal: " oldarea-acre " + " area-acre " = < " area51-acre " acres >")
          )
        )
        (list area51-feet area51-acre area51) ; return the area $|$|n
      )
    ) ; end if
  )


  ;;   Start Here  <----<<

  (setq oldecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq txtstyle (tblsearch "style" (getvar "textstyle")))
  (setq txtsize (cdr (cadddr txtstyle))
        tarea   0
  )

  (or caam:ncolor (setq caam:ncolor 3)) ; default
  (setq dcolor (cdr (assoc caam:ncolor
                           '((1 . "1 (Red)")
                             (2 . "2 (Yellow)")
                             (3 . "3 (Green)")
                             (4 . "4 (Cyan)")
                             (5 . "5 (Blue)")
                             (6 . "6 (Magenta)")
                             (7 . "7 (White)")
                            )
                    )
               )
  )
  (or dcolor (setq dcolor (itoa caam:ncolor)))

  (initget 0 "Yes No")
  (setq answr (getkword (strcat "Change Current Selection Color? [" dcolor "]  [Yes/<No>] ")))
  (if (= answr "Yes")
    (setq caam:ncolor (acad_colordlg 3 nil))
  )

  (while (setq ent (car (entsel)))
    (cond
      ((member (cdr (assoc 0 (entget ent)))
               '("LWPOLYLINE" "CIRCLE" "HATCH" "ELLIPSE" "REGION" "SPLINE")
       )
       (setq $newarea (areacalc ent tarea)
             tarea    (caddr $newarea)
       )
      )
      ((prompt "\nNot a Valid Selection"))
    ) ; end cond       
  ) ; end while

  ;;     Place Text in Drawing         ;;
  (initget 0 "Yes No")
  (setq answr2 (getkword (strcat "Place Text in Drawing?  [Yes/<No>] ")))
  (if (and (= answr2 "Yes")
           (setq pt1 (getpoint "\nPick Location... "))
      )
    (progn
      (if (= txtsize 0)
        (progn
          (setq txtsize (getreal "\nEnter Text Height: "))
          (command ".STYLE" "AREA" "SIMPLEX" txtsize "1" "0" "" "" "")
        )
      )
      (command ".text" pt1 "0" (strcat (cadr $newarea) " ACRES")
               ".text"  "" (strcat (car $newarea) " SQ FT")
      )
    ) ; progn
  ) ; end if
  (setvar "cmdecho" oldecho)
  (princ)
)
« Last Edit: May 19, 2008, 11:20:39 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

DanB

  • Bull Frog
  • Posts: 367
Re: Area Calcs (feedback)
« Reply #3 on: February 02, 2006, 03:36:49 PM »
Thanks both, these are the types of feedback I was hoping for. I will copy the revised code and compare to the original, see if I can follow along.

Open to any more suggestions...

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Area Calcs (feedback)
« Reply #4 on: February 02, 2006, 03:54:22 PM »
I changed the code. I revised the way the color was handled.  :-)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.