Help! Need a quick .LSP to measure and display areas for multiple closed polylines.

[crbateman]

Could one of you LISP gurus help me out?

I need a LISP routine that will allow me to select (using the standard methods) a group of closed polylines, and display the area of each one at its corresponding origin vertex.

At the time I run this routine, all objects in the display will be closed polylines, so there is no need to discriminate from other object types. Also, text can be displayed using whatever style, layer, and color is current at the time I run the routine.

It would be an added bonus to me if the routine would return, on the command line, the TOTAL AREA of ALL polylines selected. This is not a deal-breaker, however...

I will probably need to run this routine several times in a session, so the variables need to be reset to zero or null each time it's run.


Wish I could still do these for myself, but my LISPing days are 20 years behind me, unfortunately...


Thanks in advance!

[Tharwat]

Try this routine and let me know .

Note: If the text height is equal to zero in Current Text Style , the value of the System Variable TEXTSIZE would be considered .

(defun c:Test (/ ss l)
  ;;	Tharwat 11.July.2014		;;
  (princ "\n Select Closed Polylines ...")
  (if (setq l  0.
            ss (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)))
      )
    ((lambda (i / sn lst x y pt ar en)
       (while (setq sn (ssname ss (setq i (1+ i))))
         (setq lst (mapcar 'cdr
                           (vl-remove-if-not
                             '(lambda (p) (eq (car p) 10))
                             (entget sn)
                           )
                   )
               x   (apply '+ (mapcar 'car lst))
               y   (apply '+ (mapcar 'cadr lst))
               pt  (list (/ x (length lst)) (/ y (length lst)))
               ar  (vlax-curve-getarea sn)
               l   (+ l ar)
         )
         (entmake (list '(0 . "TEXT")
                        (cons 1 (rtos ar 2 0))
                        (cons 10 (trans pt 1 0))
                        (cons 11 (trans pt 1 0))
                        (cons 40 2.)
                        (cons 7 (getvar 'TEXTSTYLE))
                        '(71 . 0)
                        '(72 . 1)
                        '(73 . 2)
                  )
         )
       )
     )
      -1
    )
  )
  (if (< 0. l)
    (princ (strcat "\nTotal Areas: " (rtos l 2 4)))
  )
  (princ)
)

[crbateman]

Try this routine and let me know .

Almost perfect! Thanks for your quick sharing of knowledge.

The only things I'm running into with this are that a) the texts appear in "Standard" style regardless, even though (in this case) the current style is set to "Msnote", and b) I don't need any decimal places of precision (setting "Units" to 0 still results in 4 decimal places shown). The texts DO adopt the proper height of "2", with respect to the current text style...

Can be fixed?

Thanks!

[Tharwat]

I updated the routine to meet your needs in post # 3 .

Try it and let me know for any other changes or adds .

[BlackBox]

FWIW -

(vl-load-com)

(defun c:FOO (/ *error* acDoc height luprec origin oSpace area total
               insertionPoint oMText
              )

  (defun *error* (msg)
    (if acDoc
      (vla-endundomark acDoc)
    )
    (if total
      (prompt (strcat "\nTotal area: "
                      (rtos (setq total (apply '+ total)) 2 luprec)
                      " SF | "
                      (rtos (/ total 9.0) 2 luprec)
                      " SY | "
                      (rtos (/ total 43560.0) 2 luprec)
                      " AC "
              )
      )
    )
    (cond ((not msg))                                                   ; Normal exit
          ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
          ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
    )
    (princ)
  )

  (if (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)))
    (progn
      (vla-startundomark
        (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
      )
      (setq height (/ 1. (getvar 'cannoscalevalue)))
      (setq luprec (getvar 'luprec))
      (setq origin (vlax-3d-point '(0 0 0)))
      (setq oSpace
             (vlax-get acDoc
                       (if (= 1 (getvar 'cvport))
                         'paperspace
                         'modelspace
                       )
             )
      )
      (vlax-for x (vla-get-activeselectionset acDoc)
        (setq total (cons (setq area (vla-get-area x)) total))
        (vla-getboundingbox x 'mn 'mx)
        (setq insertionPoint
               (vlax-3d-point
                 (mapcar '*
                         (mapcar '+
                                 (vlax-safearray->list mn)
                                 (vlax-safearray->list mx)
                         )
                         '(0.5 0.5 0.5)
                 )
               )
        )
        (setq oMText
               (vla-addmtext
                 oSpace
                 origin
                 0.0
                 (rtos area 2 luprec)
               )
        )
        (vla-put-attachmentpoint oMText acmiddlecenter)
        (vla-move oMText origin insertionPoint)
        (vla-put-height oMText height)
      )
    )
  )
  (*error* nil)
)

[crbateman]

@THARWAT and BLACKBOX:

These both work great! LISPers rule!

Thanks again!

[Tharwat]

@THARWAT and BLACKBOX:

These both work great! LISPers rule!

Thanks again!

You're welcome .