วันพฤหัสบดีที่ 17 ธันวาคม พ.ศ. 2563

Get Area2

 

(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

(defun c:GAR()

(setq old_cmdecho  (getvar "cmdecho"))

(setvar "cmdecho" 0)

 (initget "1 2")

       (setq opt (getkword "\nSelect Options : \n [1  Pick in Area. / 2  Select Polyline Closed.] <1> "))

       (if (= opt "")(setq opt "1"))

(setq txtH 10.0); Current height

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

(setq ins 1)

(setq tot_area 0.0)

 

(if (= opt "1")

(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

);if opt "1"

(if (= opt "2")

       (if (setq ss1 (ssget '((-4 . "<OR")

                         (0 . "POLYLINE")

                         (0 . "LWPOLYLINE")

                         (0 . "CIRCLE")

                         (0 . "ELLIPSE")

                         (0 . "SPLINE")

                         (0 . "REGION")

                         (-4 . "OR>")

                        )

                                  )

              )

              (progn

                     (setq nr 0)

                     (setq en (ssname ss1 nr))

                     (while en

                           (command "._area" "_O" en)

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

                           (setq nr (1+ nr))

                           (setq en (ssname ss1 nr))

                     );while

              )

       )

);if opt "2"

       (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 5) ; 1=Top Left   /2=Top Center   /3= Top Right

                                         ; 4=Middle Left/5=Middle Center/6=Middle Right

                                         ; 7=Bottom Left/8=Bottom Center/9=Bottom Right

                     (cons 50 0.0) ; rotation angle

                     (cons 1 txt)

              )

       )

(setvar "cmdecho" old_cmdecho)

(princ)

)

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


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

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