Results 1 to 7 of 7

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

  1. #1
    100 Club
    Join Date
    2006-12
    Posts
    106
    Login to Give a bone
    0

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

    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!

  2. #2
    All AUGI, all the time
    Join Date
    2010-06
    Posts
    962
    Login to Give a bone
    0

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

    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 .

    Code:
    (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)
    )
    Last edited by Tharwat; 2014-07-11 at 06:37 PM.

  3. #3
    100 Club
    Join Date
    2006-12
    Posts
    106
    Login to Give a bone
    0

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

    Quote Originally Posted by Tharwat View Post
    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!

  4. #4
    All AUGI, all the time
    Join Date
    2010-06
    Posts
    962
    Login to Give a bone
    0

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

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

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

  5. #5
    Administrator BlackBox's Avatar
    Join Date
    2009-11
    Posts
    5,713
    Login to Give a bone
    0

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

    FWIW -

    Code:
    (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)
    )
    "How we think determines what we do, and what we do determines what we get."

    Sincpac C3D ~ Autodesk Exchange Apps

    Computer Specs:
    Dell Precision 3660, Core i9-12900K 5.2GHz, 64GB DDR5 RAM, PCIe 4.0 M.2 SSD (RAID 0), 16GB NVIDIA RTX A4000

  6. #6
    100 Club
    Join Date
    2006-12
    Posts
    106
    Login to Give a bone
    0

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

    @THARWAT and BLACKBOX:

    These both work great! LISPers rule!

    Thanks again!

  7. #7
    All AUGI, all the time
    Join Date
    2010-06
    Posts
    962
    Login to Give a bone
    0

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

    Quote Originally Posted by crbateman View Post
    @THARWAT and BLACKBOX:

    These both work great! LISPers rule!

    Thanks again!
    You're welcome .

Similar Threads

  1. program to measure and label areas
    By Wanderer in forum Facilities Management In Practice
    Replies: 0
    Last Post: 2014-07-22, 01:53 PM
  2. converting plus shapes into closed polylines
    By dd.emre285370 in forum AutoCAD General
    Replies: 1
    Last Post: 2012-01-14, 04:59 PM
  3. Replies: 0
    Last Post: 2011-11-21, 05:07 PM
  4. Quick adding of multiple closed polyline areas
    By CBLENDERMANN in forum AutoLISP
    Replies: 6
    Last Post: 2008-05-29, 04:21 PM
  5. Replies: 7
    Last Post: 2008-02-22, 04:13 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •