วันพุธที่ 16 ธันวาคม พ.ศ. 2563

Get Area

 


;----------Add Comma-------

(defun rtoc ( n p / d i l x );; n = any number  p = precision

    (setq l (vl-string->list (rtos n 2 p))

          x (cond ((cdr (member 46 (reverse l)))) ((reverse l)))

          i 0

    )

    (vl-list->string

        (append

            (reverse

                (apply 'append

                    (mapcar

                       '(lambda ( a b )

                            (if (and (zerop (rem (setq i (1+ i)) 3)) b)

                                (list a 44)

                                (list a)

                            )

                        )

                        x (append (cdr x) '(nil))

                    )

                )

            )

            (member 46 l)

        )

    )

);end

;----------Get Area----------

(defun c:GAR()

(setq old_cmdecho  (getvar "cmdecho"))

(setvar "cmdecho" 0)

(setq txtH 10.0); Current height

(setq txtS (getvar "textstyle")); Current Style

(setq ins 1)

(setq tot_area 0.0)

(while (setq ins (getpoint "\nPick in Area: "))

       (command "_boundary" ins "")   

       (command "_area" "o" "l")

       (command "_erase" "l" "")

       (setq tot_area (+ tot_area (getvar "area")))

);while

       (setq txt (strcat (rtoc tot_area 2)" m\U+00B2")) ;add , comma

       (setq pt (getpoint "\n Pick Area Location: "))

       (entmake

              (list

                     '(0 . "MTEXT")

                     '(100 . "AcDbEntity")

                     '(100 . "AcDbMText")

                     (cons 10 pt)

                     (cons 7  txtS)

                     (cons 40 txtH) 

                     (cons 41 0) ; 0 Width = no wrap

                     (cons 71 1) ; 1 = Top Left

                     (cons 50 0.0) ; rotation angle

                     (cons 1 txt)

              )

       )

(setvar "cmdecho" old_cmdecho)

(princ)

)

(prompt "\nEnter GAR to Start Get Area.")

ไม่มีความคิดเห็น:

แสดงความคิดเห็น