; Program to calculate area.
; version 3.10 Date 11-02-2003
; Used for Meters units ( 1 unit = 1 meter ) only.
; By TEERAPONG PIPATTANAKOSIT
; Add command AA0 , AA4 and AA5 for calculate Area
; Add description to use for AA0 Date 4-06-02
; Revise value intergel to real of number in AA5. Date 5-06-02
; Add command AA6 command plus many areas
; Description for AA0 command definded.
; Command for calculate transfer units type from Sq.meter to Rai-Ngan-Va.
; How to use :
; 1. Type many units do you want to transfer (units square meter only).
; 2. Pick point in locate to type units transfering.
; 3. Select defind text height to type.
; ----------------------------------------------------------------------------------------------------------------------
; Start function
(defun c:aa0 (/ vm pt an th)
(setq vm (getreal "\n How many area do you transfer
(setq AAx1 (/ vm 1600)
RAI (fix AAx1) AAx2 (* (- AAx1 RAI) 4)
NGAN (fix AAx2) AAx3 (* (- AAx2 NGAN) 100)
VA (Fix AAx3) RAI (Itoa RAI)
NGAN (Itoa NGAN) VA (Itoa VA))
(setq pt (getpoint "\nText point :")) (setq an "0")
(set_txh)
(command "Text" "j" "mc" pt th an (strcat RAI "-" NGAN "-" VA)) )
(defun sel_ob() (ver)
(while (not en) (setq en (car (entsel "\nSelect Entities: ")))
(if (not en) (prompt "\nNo entity selected --- Please Try Again : "))
)
)
(defun set_txh()
(prompt "Text Height?:<")(princ th1)(setq th (getreal ">"))
; (if (not th) (setq th 1))
(if (not th) (setq th th1)) (setq th1 th)
)
(defun c:aa1 (/ en ar pr aw wh th an pt)
(sel_ob) (Command "area" "entity" en)
(setq ar (getvar "area"))
(setq pr (getvar "perimeter"))
(setq atext (strcat "Area= " (rtos ar) " sq.m."))
(setq ptext (strcat "Perimeter= " (rtos pr) " m."))
(setq wh (getreal "\nWall Hieght <2.60>:"))
(if (not wh) (setq wh 2.60))
(setq aw (* pr wh))
(setq wtext (strcat "Area wall = " (rtos aw) " sq.m."))
(setq pt (getpoint "\nText point :"))
(set_txh)
; (setq th (getreal "\nText Height <0.18>:"))
; (if (not th) (setq th 0.18))
(setq an "0")
(command "text" pt th an atext)
(command "text" "" ptext)
(command "text" "" wtext)
(princ)
)
(defun c:aa2 (/ en pr aw wh th an pt)
(sel_ob)
(Command "area" "entity" en)
(setq pr (getvar "perimeter"))
(setq ptext (strcat "Perimeter= " (rtos pr) " m."))
(setq wh (getreal "\nWall Hieght <2.60>:"))
(if (not wh) (setq wh 2.60))
(setq aw (* pr wh))
(setq wtext (strcat "Area wall = " (rtos aw) " sq.m."))
(setq pt (getpoint "\nText point :"))
(set_txh)
(setq an "0")
(command "text" pt th an ptext)
(command "text" "" wtext)
(princ)
)
(defun c:aa3 (/ en ar pr th an pt)
(sel_ob)
(Command "area" "entity" en)
(setq ar (getvar "area"))
(setq pr (getvar "perimeter"))
(setq atext (strcat "Area= " (rtos ar) " sq.m."))
(setq ptext (strcat "Perimeter= " (rtos pr) " m."))
(setq pt (getpoint "\nText point :"))
(set_txh)
; (setq th (getreal "\nText Height <0.18>:"))
; (if (not th) (setq th 0.18))
(setq an "0")
(command "text" pt th an atext)
(command "text" "" ptext)
(princ)
)
(defun c:aa3p (/ pten en ar th an pt)
(ver) (prompt "\n Load calculate for Area")
(setq pten (getpoint "\n Pick point to calculate Area :"))
(command "-boundary" pten "")
(setq en (entlast))
(Command "area" "entity" en)
(setq ar (getvar "area"))
(setq pr (getvar "perimeter"))
(setq atext (strcat "Area= " (rtos ar) " sq.m."))
(setq ptext (strcat "Perimeter= " (rtos pr) " m."))
(setq pt (getpoint "\nText point :"))
(set_txh)
; (setq th (getreal "\nText Height <0.18>:"))
; (if (not th) (setq th 0.18))
(setq an "0")
(command "text" pt th an atext)
(command "text" "" ptext)
(princ)
)
(defun c:aa4 (/ en ar th an pt)
(sel_ob)
(Command "area" "entity" en)
(setq ar (getvar "area") AAx1 (/ ar 1600)
RAI (fix AAx1) AAx2 (* (- AAx1 RAI) 4)
NGAN (fix AAx2) AAx3 (* (- AAx2 NGAN) 100)
VA (Fix AAx3) RAI (Itoa RAI)
NGAN (Itoa NGAN) VA (Itoa VA))
(setq pt (getpoint "\nText point :"))
(setq an "0")
(set_txh)
(command "Text" "j" "mc" pt th an (strcat RAI "-" NGAN "-" VA))
(prompt " Sq.m. Units Area = ")(princ ar)(prompt " sq.m.")
(princ)
)
(defun c:aa5 (/ pten en ar th an pt)
(ver) (prompt "\n Load calculate for Area")
(setq pten (getpoint "\n Pick point to calculate Area :"))
(command "-boundary" pten "")
(setq en (entlast))
(command "area" "entity" en)
(setq ar (getvar "area") AAx1 (/ ar 1600)
RAI (fix AAx1) AAx2 (* (- AAx1 RAI) 4)
NGAN (fix AAx2) AAx3 (* (- AAx2 NGAN) 100)
VA (* (- (* (- (/ ar 1600)RAI) 4) NGAN) 100)
;VA (fix AAx3)
RAI (Itoa RAI)
NGAN (Itoa NGAN)
VA (Rtos VA))
;(setq VA (* (- (* (- (/ ar 1600)RAI) 4) NGAN) 100))
;(if ( not ar) (nil))
(command "erase" "last" "")
(setq pt (getpoint "\nText point :")) (setq an "0")
(set_txh)
(command "Text" "j" "mc" pt th an (strcat RAI "-" NGAN "-" VA))
(prompt " Sq.m. Units Area = ")(princ ar)(prompt " sq.m.")(princ)
)
(defun c:aa5f (/ pten en ar th an pt)
(ver) (prompt "\n Load calculate for Area")
(setq pten (getpoint "\n Pick point to calculate Area :"))
(command "-boundary" pten "")
(setq en (entlast))
(command "area" "entity" en)
(setq ar (getvar "area") AAx1 (/ ar 1600)
RAI (fix AAx1) AAx2 (* (- AAx1 RAI) 4)
NGAN (fix AAx2) AAx3 (* (- AAx2 NGAN) 100)
;VA (* (- (* (- (/ ar 1600)RAI) 4) NGAN) 100)
VA (fix AAx3)
RAI (Itoa RAI)
NGAN (Itoa NGAN)
VA (Rtos VA))
;(setq VA (* (- (* (- (/ ar 1600)RAI) 4) NGAN) 100))
;(if ( not ar) (nil))
(command "erase" "last" "")
(setq pt (getpoint "\nText point :")) (setq an "0")
(set_txh)
(command "Text" "j" "mc" pt th an (strcat RAI "-" NGAN "-" VA))
(prompt " Sq.m. Units Area = ")(princ ar)(prompt " sq.m.")(princ)
)
(defun c:aa6 ()
(Ver)
(command "Area" "Add" "Object")
(setq arp (getvar "area" ))
(setq atext (strcat "Area= " (rtos arp) " sq.m."))
(princ)
)
(defun ver()
;; Reset if changed
(setq aa_ver "3.10") ;
(princ (strcat "\n Calculate area, Version "
aa_ver
", Copyright ฉ 1999-03 by Teerapong, Studio Pro.ฉ"))
)
ไม่มีความคิดเห็น:
แสดงความคิดเห็น