Topic: Add acres from multiple polylines

[bmossman]

Does anyone have a routine that you can globally select multiple closed polylines & have it accumulate the areas in acres? I know the standard area command allows you to selectively pick plines individually & accumulates their sum in sq.ft. but it's a pain. It would be nice if you could just do a crossing or a window over all plines & have it return the total acres.

bman

[Keith™]

Here is a little something I had....It was for R13 and I haven't used it in a while. I hope it works right...

Code: [Select]


(defun tacres( / acres ename ndx oce sset tarea)
 ;turn off cmdecho
 (setq oce (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 ;grab plines must be closed becasue no error checking
 (setq sset (ssget '((0 . "lwpolyline"))))
 ;initialize vars
 (setq tarea 0
         ndx 0)
 ;step through selection set
 (repeat (sslength sset)
  ;gram entity name
   (setq ename (ssname sset ndx))
  ;pass it to the area command
   (command "_.area" "o" ename)
  ;grab the area and add it to our global area
  ;and index the counter
   (setq tarea (+ tarea (getvar "area"))
           ndx (1+ ndx))
 )
 ;convert the sqin to acres, this presumes the
 ;drawing is in sq in, not sq ft, change sq in to sq ft if needed
 (setq acres (cvunit tarea "sq in" "acres"))
 ;reset cmdecho
 (setvar "cmdecho" oce)
 ;report value
 acres
)


[CAB]

Here is the one i just reworked.
Some additional testing is recominded.
I am unsure of the "closed polyline" filter.
I found this: ?

Code: [Select]

(if (= 1 (logand 1 (cdr (assoc 70 (entget ent)))))
CAB

Code: [Select]

;;;-------------------------------
;;;      Measure lwPolylines    
;;;    Various selection methods
;;;          13 MAR 04          
;;;-------------------------------


;;  Select All lwpolylines
(defun c:pline_measure_all (/ ss lay usercmd)
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (princ
    "\nCalculating the Area and length of All LWpolylines\n"
  )
  (if (setq ss (ssget "X" '((0 . "LWPOLYLINE"))))
    (progn
      (setq lay "All")
      (prompt "\n=========================================================================")
      (meas)
      (prompt "\n=========================================================================")
    ) ;end progn
    (princ "\n*** No Polylines in drawing! ***\n\n")
  ) ;end if
  (setvar "CMDECHO" usercmd)
  (princ)
) ;end defun pline_measure_select

;;  User select lwpolylines
(defun c:pline_measure_select (/ ss lay usercmd)
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (princ
    "\nCalculating the Area and length of All LWpolylines\n"
  )
  (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (setq lay "All")
      (prompt "\n=========================================================================")
      (meas)
      (prompt "\n=========================================================================")
    ) ;end progn
    (princ "\n*** No Polylines Selected! ***\n\n")
  ) ;end if
  (setvar "CMDECHO" usercmd)
  (princ)
) ;end defun


;;  Pick layer to select all plines on that layer
(defun c:pline_measure_layer (/ ss lay usercmd)
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)

  (princ "\nPick any entity on the required layer\n")
  (setq ss (ssget ":S"))
  (if (= ss nil)
    (princ "\n*** Nothing was selected! ***\n\n")
    (progn
      (setq lay (cdr (assoc 8 (entget (ssname ss 0)))))
      (setq ss (ssget "X" (list (cons 8 lay))))
      (princ (strcat "\nLayer " lay " selected"))
      (meas)
    ) ;end progn
  ) ;end if
  (princ)
  (setvar "CMDECHO" usercmd)
) ;END ZONE


(defun meas (/ sslen cnt area pl_len non_pl open_pl ent)
  (setq sslen (sslength ss))
  (setq cnt (1- sslen))
  (setq area 0)
  (setq pl_len 0)
  (setq non_pl  0)
  (setq open_pl  0)
  (while (>= cnt 0)
    (setq ent (ssname ss cnt))
    (if (/= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
      (setq non_pl (1+ non_pl)) ; count non-plines
      (progn
        (if (= 1 (logand 1 (cdr (assoc 70 (entget ent))))) ; only closed plines
            (setq open_pl (1+ open_pl)); count open plines
          (progn ; get area and length
            (command "area" "e" ent)
            (setq area (+ (getvar "area") area))
            (setq pl_len (+ (getvar "perimeter") pl_len))
          )
        ) ;END IF
      ) ;END PROGN
    ) ;END IF
    (setq cnt (1- cnt)); nest entity in ss
  ) ;END WHILE
  (if (= non_pl 0)
    (princ
      (strcat "\nAll chosen entities were polylines : " (itoa sslen)))
    (princ
      (strcat "\nNumber of polyline non polylines : " (itoa non_pl)))
  )
  (if (= open_pl 0)
    (princ "\nAll polylines were closed")
    (princ (strcat "\nNumber of Polylines not closed : "(itoa open_pl)))
  )
  (prompt (strcat "\nNumber of Polylines included : "
                  (itoa (- sslen open_pl non_pl))))
  (princ (strcat "\nTotal area for "
                 lay
                 " layer = "
                 (rtos area 2 0)
                 " sq inches or "
                 (rtos (/ area 144) 2 0)
                 " sq feet"
         )
  )
  (princ (strcat "\nTotal length for "
                 lay
                 " layer = "
                 (rtos pl_len 2 0)
                 " inches or "
                 (rtos (/ pl_len 12) 2 0)
                 " feet"
         )
  )
  (princ)
) ;END MEAS

[Hangman]

Not to butt in, but I was wondering if the lsp could be enhanced to give the option of what type of measurement the operator would want, be it by square feet, square acres, square inches or square miles
So a prompt would be given either at the beginning of the program or the end, asking for one of the listed above, the make the calculation and turn out the results.   I'da thunk that adork would have been smart enough or at least listen to the requests of draftsmen enough to have incorporated this idea into their list command at some point but, alas, they are dorks.  (hense the term autodork   )
Maybe it could be written to override the current 'list' command that is now in acad .?.

Oh, I forgot to mention that there is a program available, I'm not sure if it has the option to list by acres but, the program is from Asuni-Cad, http://www.bubblecad.com/en/bubble.htm
It's called bubble.   I haven't used it for quite some time as it had a bug or two that was really giving me problems so I uninstalled it.   I believe they have updated a few versions since then though.

[daron]

go4it

[CAB]

Hangman,
If acres is all you want this will do, but the rest is up to you.

Code: [Select]

(defun meas (/ sslen cnt area pl_len non_pl open_pl ent)
  (setq sslen (sslength ss))
  (setq cnt (1- sslen))
  (setq area 0)
  (setq pl_len 0)
  (setq non_pl 0)
  (setq open_pl 0)
  (while (>= cnt 0)
    (setq ent (ssname ss cnt))
    (if (/= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
      (setq non_pl (1+ non_pl)) ; count non-plines
      (progn
(if (= 1 (logand 1 (cdr (assoc 70 (entget ent)))))
 ; only use closed plines
 (setq open_pl (1+ open_pl)) ; count open plines
 (progn ; get area and length
   (command "area" "e" ent)
   (setq area (+ (getvar "area") area))
   (setq pl_len (+ (getvar "perimeter") pl_len))
 )
) ;END IF
      ) ;END PROGN
    ) ;END IF
    (setq cnt (1- cnt)) ; nest entity in ss
  ) ;END WHILE
  (if (= non_pl 0)
    (princ
      (strcat "\nAll chosen entities were polylines : " (itoa sslen))
    )
    (princ
      (strcat "\nNumber of polyline non polylines : " (itoa non_pl))
    )
  )
  (if (= open_pl 0)
    (princ "\nAll polylines were closed")
    (princ (strcat "\nNumber of Polylines not closed : " (itoa open_pl))
    )
  )
  (prompt (strcat "\nNumber of Polylines included : "
 (itoa (- sslen open_pl non_pl))
 )
  )
  (if (= (getvar "Measurement") 0)
    (progn ; English
      (princ (strcat "\nTotal area for "
    lay
    " layer = "
    (rtos area 2 0)
    " sq inches = "
    (rtos (/ area 144) 2 0)
    " sq feet = "
    (rtos (/(/ area 144)43560) 2 2)
    " Acres = "
    (rtos (/(/(/ area 144)43560)640) 2 4)
    " Sq Miles "
    )
      )
      (princ (strcat "\nTotal length for "
    lay
    " layer = "
    (rtos pl_len 2 0)
    " inches = "
    (rtos (/ pl_len 12) 2 0)
    " feet = "
    (rtos (/(/ pl_len 12)3) 2 1)
    " Yards = "
    (rtos (/(/ pl_len 12)5280) 2 4)
    " Miles"
    )
      )
    )
    (progn ; Metric
      (princ (strcat "\nTotal area for "
    lay
    " layer = "
    (rtos area 2 0)
    "m2 or "
    (rtos (/ area 10000) 2 2)
    " Ha in "
    )
      )
      (princ (strcat "\nTotal length for "
    lay
    " layer = "
    (rtos pl_len 2 1)
    "m or "
    (rtos (/ pl_len 0.3048) 2 0)
    " feet in "
    )
      )

    )
  ) ;end if

  (princ)
) ;END MEAS