Get Mass Properties of a region and update exisitng text box

in addition i need one mor formula to be added:

https://drive.google.com/open?id=1dSQxml3u9EJjasZ4iVzDfzDkQNNrzdrr

@arkizner, I am not ready to develop this program any further on voluntary time, so if you are willing to pay for it then please contact me on private.

Okay now .

 

I did work on the program for a quite sometime that should work on very well with your new requirements besides that , with Attributed block(s) that have the same tag names as you did have in your block .

 

I also added an option to undo if you wanted to .

 

NOTE: Hope you don't remove the author name in the program .

 

Try it and let me know how things going on with you .

 

 

(defun c:WriteMass (/ *error* _get _doc cho f cl o b l _l _l1 _l2 ar srt fnd)
;;; -------------------------------------------------    ;;;
;;;    ---=== { Author : Tharwat Al Shoufi } ===---      ;;;
;;;                                                      ;;;
;;;     Write mass properties to Attributed Block(s)     ;;;
;;; -------------------------------------------------    ;;;
 (setq _doc (vla-get-activedocument (vlax-get-acad-object)))
 (defun *error* (x)
   (if (and f (setq f (findfile f)))
     (vl-file-delete f)
   )
   (if cho
     (setvar 'cmdecho cho)
   )
   (if (and x
            (not (wcmatch (strcase x) "*BREAK*,*EXIT*,*CANCEL*"))
       )
     (princ "Error:" x "...")
   )
 )
;;;                                ;;;
 (defun _get (f / of s lst l)
   (if (and (setq of (open f "r"))
            (while
              (setq s (read-line of))
               (setq lst (cons s lst))
            )
       )
     (progn
       (close of)
       (if (setq lst (reverse lst))
         (mapcar '(lambda (i) (setq l (cons (nth i lst) l)))
                 '(3 4 5 6 9 10 12 13)
         )
       )
       (setq l (reverse l))
     )
   )
   l
 )
;;;                                ;;;
 (cond
   ((or (minusp (cdr (assoc 62
                            (setq cl
                                   (entget
                                     (tblobjname "LAYER" (getvar 'CLAYER))
                                   )
                            )
                     )
                )
        )
        (= 4 (logand 4 (cdr (assoc 70 cl))))
    )
    (alert "<!> Current Layer is either OFF or LOCKED <!>")
   )
   ((and
      (princ
        "\n Select CLOSED Object [REGION,CIRCLE,ELLIPSE,LWpolyline] :"
      )
      (not (setq o (ssget "_+.:S:E:L"
                          '((-4 . "<OR")
                            (0 . "REGION,CIRCLE,ELLIPSE")
                            (-4 . "<AND")
                            (0 . "LWPOLYLINE")
                            (-4 . "&=")
                            (70 . 1)
                            (-4 . "AND>")
                            (-4 . "OR>")
                           )
                   )
           )
      )
    )
    (alert
      "\n << nil or Invalid Object or on Locked Layer !! >>"
    )
   )
   ((and (princ "\n Select Attributed Block(s) :")
         (not (setq b (ssget "_:L" '((0 . "INSERT") (66 . 1)))))
    )
    (alert "Invalid object . Should be Attributed Block(s) !")
   )
 )
 (if (and b
          (if (not (setq f (vl-filename-mktemp nil nil ".mpr")))
            (alert "Can't create the text file !!")
            t
          )
     )
   (progn
     (if (eq (cdr (assoc 0 (entget (ssname o 0)))) "REGION")
       (setq r (list (vlax-ename->vla-object (ssname o 0))))
       (setq r (vl-catch-all-apply
                 'vlax-invoke
                 (list
                   (vla-get-block
                     (vla-get-activelayout
                       (vla-get-ActiveDocument
                         (vlax-get-acad-object)
                       )
                     )
                   )
                   'Addregion
                   (list (vlax-ename->vla-object (ssname o 0)))
                 )
               )
             d t
       )
     )
     (setq cho (getvar 'cmdecho))
     (setvar 'cmdecho 0)
     (command "_.ucs"
              "_Origin"
              (setq p (vlax-get (car r) 'Centroid))
     )
     (command "_.massprop"
              (vlax-vla-object->ename (car r))
              ""
              "y"
              (vl-string-translate "\\" "/" f)
     )
     (command "_.ucs" "w")
     (setvar 'cmdecho cho)
     (if d
       (vla-delete (car r))
     )
     (if (zerop (getvar 'PDMODE))
       (setvar 'PDMODE 34)
     )
     (entmake
       (list '(0 . "POINT")
             (cons 10 p)
       )
     )
     (if (setq l (_get f))
       (progn
         (setq _l1 (mapcar
                     '(lambda (s d / p a b c)
                        (setq p (vl-string-search d s)
                              a (vl-string-trim
                                  " "
                                  (substr s (+ p 3))
                                )
                              p (vl-string-search "--" a)
                              b (substr a 1 p)
                              c (vl-string-trim
                                  " "
                                  (substr a (+ p 3))
                                )
                              b (if (wcmatch b "-*")
                                  (substr b 2)
                                  b
                                )
                              c (if (wcmatch c "-*")
                                  (substr c 2)
                                  c
                                )
                        )
                        (mapcar '(lambda (x) (vl-string-trim " " x))
                                (list b c)
                        )
                      )
                     (list (nth 2 l) (nth 3 l))
                     '("X:" "Y:")
                   )
               _l2 (mapcar '(lambda (s d / p a)
                              (setq p (vl-string-search d s)
                                    a (vl-string-trim
                                        " "
                                        (substr (vl-string-trim
                                                  " "
                                                  (substr s (+ p 3))
                                                )
                                                1
                                                p
                                        )
                                      )
                              )
                              a
                            )
                           (list (nth 4 l)
                                 (nth 5 l)
                                 (nth 6 l)
                                 (nth 7 l)
                           )
                           '("X:" "Y:" "X:" "Y:")
                   )
               ar  (vl-string-trim " " (substr (car l) 6))
               srt (list
                     ar
                     (vl-string-trim " " (substr (cadr l) 12))
                     (rtos (max (read (caar _l1))
                                (read (cadar _l1))
                           )
                           2
                           3
                     )
                     (rtos (max (read (caadr _l1))
                                (read (cadadr _l1))
                           )
                           2
                           3
                     )
                     "0.0000"
                     "0.0000"
                     (car _l2)
                     (cadr _l2)
                     (rtos (/ (read (car _l2))
                              (max (read (caadr _l1))
                                   (read (cadadr _l1))
                              )
                           )
                           2
                           3
                     )
                     (rtos (/ (read (cadr _l2))
                              (max (read (caar _l1))
                                   (read (cadar _l1))
                              )
                           )
                           2
                           3
                     )
                     (caddr _l2)
                     (nth 3 _l2)
                     (rtos (* (read ar) 0.00271) 2 3)
                   )
               _l  (mapcar '(lambda (j k) (cons j k))
                           '("AREA" "PERIMETER" "BOUNDING_BOX_X_MAX"
                             "BOUNDING_BOX_Y_MAX" "CENTROID_X"
                             "CENTROID_Y" "MOMENT_OF_INERTIA_X"
                             "MOMENT_OF_INERTIA_Y" "SECTION_MODULUS_ZX"
                             "SECTION_MODULUS_ZY"
                             "RADIUS_OF_GYRATION_X"
                             "RADIUS_OF_GYRATION_Y" "WEIGHT"
                            )
                           srt
                   )
         )
         (vla-startUndomark _doc)
         ((lambda (n / sn)
            (while (setq sn (ssname b (setq n (1+ n))))
              (mapcar
                '(lambda (x)
                   (if (setq
                         fnd (assoc (vla-get-tagstring x)
                                    _l
                             )
                       )
                     (vla-put-textstring x (cdr fnd))
                   )
                 )
                (vlax-invoke
                  (vlax-ename->vla-object sn)
                  'getattributes
                )
              )
            )
          )
           -1
         )
         (vla-endundomark _doc)
       )
     )
   )
 )
 (terpri)
 (*error* nil)
 (princ "\nThis Program is written by Tharwat Al Shoufi .")
 (princ)
)
(vl-load-com)
(princ
 "\n** Type WriteMass to start.. Author: Tharwat Al Shoufi .*"
)
(princ)

This code by Tharwat as discussed before is excellent.

I do have a query, I am curious to know why the initial closed object selected is not highlighted.

Would it have something to do with the ssget options?

I am just looking for an explanation to help my understanding.

Thank You.

I do have a query, I am curious to know why the initial closed object selected is not highlighted.

Hi,

Because the mode of the ssget function is single so user would not be able to see the highlighting of the picked object, but if the selection set is multiple then in that case the program would wait for the user to hit Enter then within this short period of time user would be able to see the highlighted objects.

Hi,

Because the mode of the ssget function is single so user would not be able to see the highlighting of the picked object, but if the selection set is multiple then in that case the program would wait for the user to hit Enter then within this short period of time user would be able to see the highlighted objects.

Hi Tharwat,

Thank you for your concise and clear response. It certainly makes it easy for a lisp novice like me to understand.

As a footnote, I must say that I like the way you have added alerts that pop when the object selection is not applicable or is on a locked layer.

Very impressive.

Cheers.

Hi Tharwat,

 

Thank you for your concise and clear response. It certainly makes it easy for a lisp novice like me to understand.

 

As a footnote, I must say that I like the way you have added alerts that pop when the object selection is not applicable or is on a locked layer.

Very impressive.

 

Cheers.

Glad to hear that.

You are welcome anytime.