***ScaleArea ตัวนี้จะมีสองส่วนด้วยกันเป็นไฟล์ Dialog
Control กับตัว Lisp File ให้ Copy แยกเป็นไฟล์ ScaleArea.dcl กับ
ScaleArea.lsp โดยสร้างโฟลเดอร์ใหม่แล้วบันทึกทั้งสองไฟล์นี้ไว้ในโฟลเดอร์นี้แล้วทำการ
Set Support Files Search Path โฟลเดอร์นี้ด้วยจึงจะสามารถใช้งานได้***
//Save
As Name : ScaleArea.dcl
ScaleArea
: dialog
{
label = "Scale AREA ";
: boxed_row
{
label = "ย่อ - ขยายพื้นที่ / Scale Area";
width = 15;
fixed_width = true;
: column
{
: button
{
label =
"Pick Area";
key =
"hide";
width = 8;
fixed_width =
true;
mnemonic =
"P";
}
: edit_box
{
key =
"eb4";
label = "พื้ น ที่ จ ริ ง m\U+00B2 ";
width = 8;
fixed_width =
true;
}
: edit_box
{
key =
"eb5";
label = "พื้นที่ย่อ - ขขาย m\U+00B2";
width = 8;
fixed_width =
true;
}
}
: column
{
: edit_box
{
key =
"eb1";
label =
"&X :";
width = 3;
fixed_width =
true;
}
: edit_box
{
key =
"eb2";
label =
"&Y :";
width = 3;
fixed_width =
true;
}
: edit_box
{
key =
"eb3";
label =
"&Z :";
width = 3;
fixed_width =
true;
}
}
}
ok_cancel;
: row
{
: image //define image tile
{
key = "im" ;
//give it a name
height = 2.5 ; //and a
height
width = 10 ; //and now a
width
alignment = centered;
} //end image
: paragraph
{
: text_part
{
label = "Scale
Area by Songkhran Jongkul Sep. 2016";
}
}//paragraph
}//boxed_column
}//End
//End
of dialog control ScaleArea.dcl
;;--------Lisp
File Save As Name : ScaleArea.lsp
(defun
scar ()
(setq
old_cmdecho (getvar
"cmdecho"))
(setvar
"cmdecho" 0)
(IF
(NOT ptx) (SETQ ptx
"0") (if (= (type ptx)
'STR) T (SETQ ptx "0")));edt1
(IF
(NOT pty) (SETQ pty
"0") (if (= (type pty)
'STR) T (SETQ pty "0")));edt2
(IF
(NOT ptz) (SETQ ptz
"0") (if (= (type ptz)
'STR) T (SETQ ptz "0")));edt3
(IF
(NOT area1) (SETQ area1
"0")(if (= (type area1) 'STR)T (SETQ area1 "0")));edt4
(IF
(NOT area2) (SETQ area2
"0")(if (= (type area2) 'STR)T (SETQ area2 "0")));edt5
(setq
flag 4);setq
;set default x,y, and z values
;and set flag to 4
(if(not(setq
dcl_id (load_dialog "ScaleArea.dcl")))
(progn
(alert "The DCL file could
not be loaded!")
(exit)
)
(progn
(while
(> flag 2)
(if (not(new_dialog "ScaleArea"
dcl_id))
(progn
(alert "The Scale Area
definition could not be loaded!")
(exit)
)
(progn
;;------------Signager
Image---------------------
(setq w (dimx_tile "im")
;get image tile width
h (dimy_tile "im") ;get image tile
height
);setq
(start_image "im")
;start the image
(fill_image 0 0 w h -15) ;fill it
with blue
(mapcar 'vector_image; Color 5
(list 36 42 42 48 54 48 48
42 36 21 21 27 27 33 32 32 32 27 27 21
5 5 8 15 11 11
5 5 5 8 18
21 18 11 11 11 15 15 21 18 8 5)
(list 8 15 15 27
3 3 3
3 3 11 27 18 18 27 15 15 3 11
3 3 6 14 17 17 24 20 20 20 24 27 27 24 14 14 6
6 6 11 3
3 3 6)
(list 36 42 48 54 54 54 48
48 42 21 27 27 33 42 36 36 36 32 27 27 5 8 15 15 15 11 11 5 8 18
21 21 21 18 11 15 15 21 21 21 18 8)
(list 22 27 27 27 27 3 18 18
3 17 27 27 27 27 22 8 3 3 11 3 14 17 17 24 24 24 20 24 27 27 24 27 17 14
14 6 11 11 6
6 3 3)
(list 5
5 5 5
5 5 5
5 5 5
5 5 5
5 5 5
5 5 5
5 5 5
5 5 5
5 5 5
5 5 5
5 5 5
5 5 5
5 5 5 5 5)
);mapcar
(end_image)
(set_tile "eb1" ptx)
(set_tile "eb2" pty)
(set_tile "eb3" ptz)
(set_tile "eb4" area1)
(set_tile "eb5" area2)
(mode_tile "eb1" 1);0 on
;1 off
(mode_tile "eb2" 1)
(mode_tile "eb3" 1)
(mode_tile "eb4" 1)
(mode_tile "eb5" 0)
(mode_tile "eb5" 2)
;set focus to x edit box
(mode_tile "eb4" 2)
;set focus to x edit box
(mode_tile "eb5" 3)
;select contents
(action_tile
"cancel"
"(done_dialog)
(setq result nil)
(exit)"
)
(action_tile
"accept"
"(setq ptx (get_tile \"eb1\"))
(setq pty
(get_tile \"eb2\"))
(setq ptz
(get_tile \"eb3\"))
(setq area2 (get_tile \"eb5\"))
(done_dialog)
(setq result T)"
)
(action_tile
"hide"
"(done_dialog 4)"
)
(setq flag (start_dialog))
(if (= flag 4)
(progn
(setq selpoint (getpoint
"\nInsertion Point: "))
(setq ptx (rtos (car selpoint) 2
4))
(setq pty (rtos (cadr selpoint) 2
4))
(setq ptz (rtos (caddr selpoint) 2
4))
(setq txtH (getvar
"TEXTSIZE")); Current height
(setq txtS (getvar
"textstyle")); Current Style
(setq int_reg selpoint)
(command "._-boundary"
int_reg "")
;(command "region"
"last" "")
(setq entidad (entlast))
(setq obj
(vlax-ename->vla-object entidad))
(setq m_area
(vla-get-area obj))
(setq area1 (rtos m_area 2 2))
(setq sqm m_area)
(setq rl_r (fix(/ sqm 1600)))
(setq rl_ng (fix(/ (- sqm (* rl_r
1600)) 400)))
(setq rl_wa (/ (- sqm (+ (* rl_r
1600) (* rl_ng 400))) 4))
(setq old_area (strcat "พื้นที่เดิม = " (rtos rl_r 2 0) " ไร่
"(rtos rl_ng 2 0) " งาน " (rtos
rl_wa 2 2) " ตารางวา" "\n"
"Old
Area = " (rtos sqm 2 2) " m\U+00B2"
)
)
(txtme int_reg txtH 8 txtS
old_area)
(princ)
);progn
);if flag 4
);progn
);if
);while
(setq area1 (atof area1))
(setq area2 (atof area2))
(setq scl (sqrt(/ area2 m_area)))
(command "_scale" entidad
"" int_reg scl)
(setq sqm area2)
(setq rl_r (fix(/ sqm 1600)))
(setq rl_ng (fix(/ (- sqm (* rl_r 1600))
400)))
(setq rl_wa (/ (- sqm (+ (* rl_r 1600) (*
rl_ng 400))) 4))
(setq new_area (strcat "พื้นที่ ย่อ-ขยาย = " (rtos rl_r 2 0) " ไร่
"(rtos rl_ng 2 0) " งาน " (rtos
rl_wa 2 2) " ตารางวา" "\n"
"New Area
= " (rtos sqm 2 2) " m\U+00B2"
)
)
(txtme int_reg txtH 2 txtS new_area)
(setq area1 (rtos area1 2 3)
area2 (rtos area2 2 3)
)
(unload_dialog dcl_id)
(setvar
"cmdecho" old_cmdecho)
(princ)
);progn
);if
not dcl_id
);defun
;----------------------------------------------------;
(princ);load
clean
(defun
c:SAR ()
(scar)
)
(prompt
"\nCreate and Design by Songkhran Jongkul August 2016")
(prompt
"\nEnter SAR to start Scale Area")
(defun
txtme (ptxt txtH pos txtS txt /)
(entmake
(list
(cons 0 "MTEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 410 "Model")
(cons 8 "0")
(cons 10 ptxt);text position
(cons 40 txtH);text height
(cons 71 pos) ; 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 72 5)
(cons 7 txtS)
(cons 1 txt);text massege
(cons 11 '(1.0 0.0 0.0))
); list
);
entmake
)
;;---------------End
of Lisp File--------------------
