Topic: Area counters

[McRojo the Irishman]

I know I keep asking for stuff, but I respect, admire, and am simply amazed at the help the wonderful... aww... nevermind

Does anyone have a good area counter for me that allows me to select closed polylines en masse, without having to select individuals?  I had one once called 'totarea'.  Ring any bells?

[CAB]

Don't have the one you are looking for but this one can be modified to get only closed plines.

Code: [Select]

;;POLYAREA.LSP - (c) 1997-2001 Tee Square Graphics
;;
;;  Calculates the area of one or more closed polylines and
;;  displays the result in an AutoCAD Alert Window.
;;
(defun c:polyarea (/ a ss n du)
  (setq a  0
        ;du (getvar "dimunit")
        ss (ssget '((0 . "*POLYLINE")))
  )
  (if ss
    (progn
      (setq n (1- (sslength ss)))
      (while (>= n 0)
        (command "_.area" "_o" (ssname ss n))
        (setq a (+ a (getvar "area"))
              n (1- n)
        )
      )
      (alert
        (strcat "The total area of the selected\nobject(s) is "
                ;(if (or (= du 3) (= du 4) (= du 6))
                  (strcat
                    (rtos a 2 2)
                    " Square Inches,\nor\n "
                    (rtos (/ a 144.0) 2 3)
                    " Square Feet, \nor\n "
                    (rtos (cvunit a "sq in" "acres") 2 3)
                    " Acres"
                  )
                ;)
        )
      )
    )
    (alert "\nNo Polylines selected!")
  )
  (princ)
)
(alert
  (strcat "POLYAREA.LSP  (c) 1997-2001 Tee Square Graphics"
          "\n\n                Type POLYAREA to start"
  )
)
(princ)

[Slim©]

Or may be this one:

DCL file save as DDAREA.DCL

Code: [Select]

//Tip1645b: DDAREA.DCL    Label Areas     (c)2000, Brian Strandberg  

ddarea : dialog {
value = "DDarea Settings - CANCEL YOU WILL LOCKUP";
key = "title";

:row {
: boxed_column {
label="Text Settings: ";

: edit_box {
label = "Area Name:   ";
key = "obj";
fixed_width = true;
}


: edit_box {
label = "Start Number:";
fixed_width = true;
key = "num";
}

: toggle {
label = "Label Objects on Screen";
key = "lbl";
}

: edit_box {
label = "Text Height:   ";
fixed_width = true;
key = "thei";
}

: edit_box {
label = "Text Rotation:";
fixed_width = true;
key = "trot";
}
}

:spacer{
width=0;
}



: boxed_column{
label = "Labeling";
key = "bc";

: toggle {
label = "Object Number ";
key = "ID";
}

: toggle {
label = "Area in Square Feet";
key = "area";
}

: toggle {
label = "Area in Acres";
key = "areac";
}


: toggle {
label = "Perimeter ";
key = "peri";
}



:button {
label = "Output File";
key = "out";
width=1;
}

: toggle {
label = "Create Output File ";
key = "sof";
}

}


}


:spacer{
height=0;
}


: boxed_row{
label = "Boundary Options";


:column {
: toggle {
label = "Retain Boundary Lines ";
key="rbl";
}


}


}



:spacer{
height=1;
}



:row{

:spacer{
width=3;
}

:button{
label="Select Objects";
key="accept";
}

:button{
label="Boundary";
key="acceptb";
}




cancel_button;





:spacer{
width=3;
}

}


}












Lisp file saveas DDAREA.LSP

Code: [Select]

;Tip1645a: DDAREA.LSP    Label Areas         (c)2000, Brian Strandberg

; Global Variables
(setq BW_AREA_OBJ "Object: ")
(setq ADDT 1)
(setq BW_AREA_THEI (* 0.125 (getvar "dimscale")))
(setq BW_AREA_TROT 0)
(setq BW_AREA_AREA 1)
(setq BW_AREA_PERI 0)
(setq BW_AREA_ID 1)
(setq BW_AREA_LBL 1)
(setq BW_AREA_AREAC 0)
(setq BW_AREA_RBL 0)
(setq BW_AREA_SOF 0)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq BW_AREA_FD (strcat (getvar "DWGPREFIX") "ddarea.txt"))
; edit this to change the default location of the output file

(defun BW_AREA (/ A TEXT NUM LEN C D E F H TOTAL TOTALP)
   (setvar "hpbound" 1)
   (setvar "cmdecho" 0)
   (if (= 1 BW_AREA_SOF)
      (setq FD (open BW_AREA_FD "a"))
      ()
   ) ;_ end of if
   (setq TOTAL 0)
   (setq TOTALP 0) ; Select objects or boundary  *******************
   (if (/= RET 2)
      (setq A (ssget))
      (progn (BW_BOUND) (setq A BW_BOUND_SET))
   ) ;_ end of if
   (setq TSH (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
   (if (= TSH 0)
      (princ)
      (command "-style" "" "" "0" "" "" "" "" "")
   ) ;_ end of if
   (setq NUM 0)
   (setq LEN (sslength A))
   (if (= 1 BW_AREA_SOF)
      (progn (princ "\n\n\n" FD)
             (if (= 1 BW_AREA_ID)
                (princ BW_AREA_OBJ FD)
                ()
             ) ;_ end of if
             (if (= 1 BW_AREA_AREA)
                (princ ",Sq. Ft." FD)
                ()
             ) ;_ end of if
             (if (= 1 BW_AREA_AREAC)
                (princ ",Acres" FD)
                ()
             ) ;_ end of if
             (if (= 1 BW_AREA_PERI)
                (princ ",Perimeter" FD)
                ()
             ) ;_ end of if
      ) ;_ end of progn
      ()
   ) ;_ end of if
   (repeat LEN
      (setq C (ssname A NUM))
      (setq D (entget C))
      (setq E (cdr (assoc -1 D)))
      (command ".area" "O" E)
      (princ "\n")
      (if (= 1 BW_AREA_SOF)
         (progn (princ "\n " FD)
                (if (= 1 BW_AREA_ID)
                   (if (not BW_AREA_SOF)
                      (princ BW_AREA_OBJ FD)
                      ()
                   ) ;_ end of if
                   ()
                ) ;_ end of if
                (setq QQ (+ ADDT NUM))
                (if (= 1 BW_AREA_ID)
                   (princ (strcat "" (itoa QQ)) FD)
                   ()
                ) ;_ end of if
                (if (= 1 BW_AREA_AREA)
                   (progn (princ (strcat "," (rtos (getvar "area"))) FD))
                   ()
                ) ;_ end of if
                (if (= 1 BW_AREA_AREAC)
                   (progn (setq T1 (cvunit (getvar "area") "sq feet" "Acres"))
                          (princ (strcat "," (rtos T1)) FD)
                   ) ;_ end of progn
                   ()
                ) ;_ end of if
                (if (= 1 BW_AREA_PERI)
                   (progn (princ (strcat "," (rtos (getvar "Perimeter"))) FD))
                   ()
                ) ;_ end of if
                (setq TOTALP (+ TOTALP (getvar "perimeter")))
                (setq TOTAL (+ TOTAL (getvar "AREA")))
         ) ;_ end of progn
         ()
      ) ;_ end of if
      (if (= 1 BW_AREA_LBL)
         (BW-LABEL)
         ()
      ) ;_ end of if
      (setq NUM (+ 1 NUM))
   ) ;_ end of repeat
   (if (and (= RET 2) (= BW_AREA_RBL 0))
      (command ".erase" A "")
      ()
   ) ;_ end of if
   (if (= 1 BW_AREA_SOF)
      (progn (if (= 1 BW_AREA_AREA)
                (progn (princ "\nThe total area(SF) is:  " FD) (princ TOTAL FD))
                ()
             ) ;_ end of IF
             (if (= 1 BW_AREA_AREAC)
                (progn (princ "\nThe total area(Acres) is:  " FD)
                       (princ (cvunit TOTAL "Sq Feet" "Acres") FD)
                ) ;_ end of PROGN
                ()
             ) ;_ end of IF
             (if (= 1 BW_AREA_PERI)
                (progn (princ "\nThe total perimeter is:  " FD) (princ TOTALP FD))
                ()
             ) ;_ end of IF
      ) ;_ end of progn
      ()
   ) ;_ end of if
   (if (/= TSH 0.0)
      (command "-style" "" "" TSH "" "" "" "" "")
      ()
   ) ;_ end of if
   (setq ADDT (+ ADDT NUM)) ; prevent repeating numbers
   (if (= 0 BW_AREA_SOF)
      ()
      (close FD)
   ) ;_ end of if
   (princ)
) ;_ end of defun




(defun BW-LABEL (/ TINS)
   (redraw E 3)
   (setq TINS (getpoint "\nText insertion point: "))
   (if (= 1 BW_AREA_ID)
      (progn (command ".text"
                      "m"
                      TINS
                      BW_AREA_THEI
                      BW_AREA_TROT
                      (strcat BW_AREA_OBJ (itoa (+ ADDT NUM)))
             ) ;_ end of command
      ) ;_ end of progn
      (command ".text" "m" TINS BW_AREA_THEI BW_AREA_TROT "")
   ) ;_ end of if
   (if (= 1 BW_AREA_AREA)
      (progn (command ".text" "" (strcat (rtos (getvar "area")) " SF")))
      ()
   ) ;_ end of if
   (if (= 1 BW_AREA_AREAC)
      (progn (command ".text"
                      ""
                      (strcat (rtos (cvunit (getvar "area") "sq feet" "Acres")) " AC")
             ) ;_ end of command
      ) ;_ end of progn
      ()
   ) ;_ end of if
   (if (= 1 BW_AREA_PERI)
      (progn (command ".text" "" (strcat (rtos (getvar "Perimeter")) " P")))
      ()
   ) ;_ end of if
   (setq BW_TEMP (cdr (assoc -1 (entget (entlast)))))
   (redraw E 4)
) ;close routine


(defun BW_GF (/)
   (setq BW_FD (getfiled "Select an output File" BW_AREA_FD "TXT" (+ 1 2 4)))
) ;_ end of defun


(defun BW_AREA_SETUP (/)
   (set_tile "obj" BW_AREA_OBJ)
   (set_tile "num" (itoa ADDT))
   (set_tile "thei" (rtos BW_AREA_THEI))
   (set_tile "trot" (rtos BW_AREA_TROT))
   (set_tile "ID" (itoa BW_AREA_ID))
   (set_tile "area" (itoa BW_AREA_AREA))
   (set_tile "areac" (itoa BW_AREA_AREAC))
   (set_tile "peri" (itoa BW_AREA_PERI))
   (set_tile "lbl" (itoa BW_AREA_LBL))
   (set_tile "rbl" (itoa BW_AREA_RBL))
   (set_tile "sof" (itoa BW_AREA_SOF))
   (if (= BW_AREA_LBL 0)
      (progn (mode_tile "thei" 1) (mode_tile "trot" 1))
      ()
   ) ;_ end of if
) ;_ end of defun



(defun BW_LBL1 ($VAL /)
   (if (= $VAL "0")
      (progn (mode_tile "thei" 1) (mode_tile "trot" 1))
      (progn (mode_tile "thei" 0) (mode_tile "trot" 0))
   ) ;_ end of if
   (setq BW_AREA_LBL (atoi $VAL))
) ;_ end of defun








(defun C:DDAREA (/)
   (setq DH (load_dialog "ddarea"))
   (new_dialog "ddarea" DH)
   (BW_AREA_SETUP)
   (action_tile "accept" "(done_dialog 1)")
   (action_tile "acceptb" "(done_dialog 2)")
   (action_tile "cancel" "(exit)(exit)")
   (action_tile "obj" "(progn (setq bw_area_obj $value)(bw_area_setup))")
   (action_tile "num" "(progn (setq addt (atoi $value))(bw_area_setup))")
   (action_tile "thei" "(progn (setq bw_area_thei (atof $value))(bw_area_setup))")
   (action_tile "trot" "(progn (setq bw_area_trot (atof $value))(bw_area_setup))")
   (action_tile "ID" "(progn (setq bw_area_id (atoi $value))(bw_area_setup))")
   (action_tile "area" "(progn (setq bw_area_area (atoi $value))(bw_area_setup))")
   (action_tile "areac" "(progn (setq bw_area_areac (atoi $value))(bw_area_setup))")
   (action_tile "peri" "(progn (setq bw_area_peri (atoi $value))(bw_area_setup))")
   (action_tile "lbl" "(bw_lbl1 $value)")
   (action_tile "out" "(bw_gf)")
   (action_tile "rbl" "(progn (setq bw_area_rbl (atoi $value))(bw_area_setup))")
   (action_tile "sof" "(progn (setq bw_area_sof (atoi $value))(bw_area_setup))")
   (setq RET (start_dialog))
   (BW_AREA)
) ;_ end of defun



(defun BW_BOUND (/ A C DQ B1)
   (setq B1 1)
   (setq BW_BOUND_SET NIL)
   (setq DQ NIL)
   (setq A (entlast)) ;Selecting Entities Start********%%%%%%%%
   (princ "\nEnter Points For Boundary Selection, Return to End: ")
   (while (/= NIL B1)
      (setq B1 (getpoint))
      (if (/= NIL B1)
         (command "-boundary" B1 "")
         ()
      ) ;_ end of if
      (if (= BW_AREA_BV 1)
         (progn (setq KB (entlast))
                (princ "\n")
                (initget "Yes No")
                (setq KBL (getkword "Keep Boundary Line? (Yes or No) "))
                (if (= KBL "N")
                   (command ".erase" KB "")
                   ()
                ) ;_ end of if
         ) ;close progn
         ()
      ) ;close if
   ) ; end while
   (setq D (ssget "L"))
   (setq C (entnext A))
   (while (/= NIL C) (setq DQ (ssadd C D)) (setq C (entnext C)))
 ;Selecting Entities End*********%%%%%%%%%
   (setq BW_BOUND_SET DQ)
   (if (= NIL BW_BOUND_SET)
      (progn (alert "Must indicate at least one valid\n\nBoundary set.  Exiting Program")
             (exit)
      ) ;_ end of progn
      ()
   ) ;_ end of if
) ;_ end of defun







[McRojo the Irishman]

Thanks CAB!  Thanks Lance!

CAB, works perfectly.  I like that the results appear on screen.  It's quick and easy.

Lance, I tried the LISP counter and will have to see how to fix the text size.  At first I didn't know it put text in the box, it was so small.  And to show my lack of programming knowledge, I'm not sure how to use your DCL file.  I mean, I don't even know what file type to save it as!  

Good stuff... different uses for different times.

[Mark]

- Lance

If you know who wrote that you might want to include their name with the code. Don't want to get into trouble here.  

[CAB]

;Tip1645a: DDAREA.LSP    Label Areas     (c)2000, Brian Strandberg
http://new.cadalyst.com/code/

[Mark]

thanks CAB. And thanks Brian Strandberg.

[McRojo the Irishman]

Aye... Thanks CAB and Brian!  And don't forget to thank your recruiter.

[Slim©]

Thanks CAB!  Thanks Lance!

CAB, works perfectly.  I like that the results appear on screen.  It's quick and easy.

Lance, I tried the LISP counter and will have to see how to fix the text size.  At first I didn't know it put text in the box, it was so small.  And to show my lack of programming knowledge, I'm not sure how to use your DCL file.  I mean, I don't even know what file type to save it as!  

Good stuff... different uses for different times.

Not a problem code has been updated. Be carefull useing the CANCEL button locks up my machine.