Chào bạn mrmoon273,
Mình viết cái lisp này xong mới biết bác SSG đã viết rồi, tuy vậy mình vẫn gửi để bạn tham khảo. Cả lisp của mình và của bác SSG đều chỉ đúng khi cái insert point của block đèn của bạn trùng với tâm của block. Trong trường hợp cái insert point của bạn lệch tâm thì bạn cần xác định khoảng lệch tâm này và hiệu chỉnh nó lại bằng lệnh move co phù hợp bạn...

Chào bạn mrmoon273,
Mình viết cái lisp này xong mới biết bác SSG đã viết rồi, tuy vậy mình vẫn gửi để bạn tham khảo. Cả lisp của mình và của bác SSG đều chỉ đúng khi cái insert point của block đèn của bạn trùng với tâm của block. Trong trường hợp cái insert point của bạn lệch tâm thì bạn cần xác định khoảng lệch tâm này và hiệu chỉnh nó lại bằng lệnh move co phù hợp bạn nhé.
Lisp của mình đây:


Chúc bạn vui.

Nếu bản vẽ chứa ít đối tượng thì việc regen bản vẽ không vấn đề gì. Mình không muốn regen trong trường hợp bản vẽ chứa số lượng lớn đối tượng. trong trường hợp đó, nếu ta cứ entnext thì mình chắc là không nhanh hơn việc regen là bao.
Do ý định ban đầu phá sản nên mình tính đến 1 giải pháp khác khả dĩ hơn. Chỉ UpdateField cho các đối tượng trong phạm vi nhìn thấy trên màn...

Nếu bản vẽ chứa ít đối tượng thì việc regen bản vẽ không vấn đề gì. Mình không muốn regen trong trường hợp bản vẽ chứa số lượng lớn đối tượng. trong trường hợp đó, nếu ta cứ entnext thì mình chắc là không nhanh hơn việc regen là bao.
Do ý định ban đầu phá sản nên mình tính đến 1 giải pháp khác khả dĩ hơn. Chỉ UpdateField cho các đối tượng trong phạm vi nhìn thấy trên màn hình (giống hatch). cảm ơn bạn đã nhiệt tình

;;; reset field - Thuylinh313
(defun c:rf (/ x y c)
(setq x (getvar"screensize")
y (* 0.5 (getvar"viewsize"))
c (getvar "viewctr"))
(vl-cmdf "UPDATEFIELD"
(ssget "c"
(polar (polar c (* 0.5 pi) y) pi (/(* y (car x)) (cadr x)))
(polar (polar c (* -0.5 pi) y) 0 (/(* y (car x)) (cadr x)))
'((0 . "INSERT,*TEXT"))) "")
(princ))

Các bác cho hỏi các hàm reactor chỉ có tác dụng trên bản vẽ hiện hành phải không, khi đóng bản vẽ và mở lại thì không còn tác dụng? Ví dụ lisp vẽ đường tâm của Leemac. Bác nào biết trả lời giúp. Thanks.

;;--------------=={ Associative Centerlines }==---------------;;
;; ;;
;; Uses reactors to update centerlines following ;;
;; modification...

Các bác cho hỏi các hàm reactor chỉ có tác dụng trên bản vẽ hiện hành phải không, khi đóng bản vẽ và mở lại thì không còn tác dụng? Ví dụ lisp vẽ đường tâm của Leemac. Bác nào biết trả lời giúp. Thanks.

;;--------------=={ Associative Centerlines }==---------------;;
;; ;;
;; Uses reactors to update centerlines following ;;
;; modification of associated circles. Stores entity handles ;;
;; in entity xData to enable reactor rebuild upon loading, ;;
;; allowing retention of associativity between sessions. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright ? 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Version 1.0 - 12-05-2011 ;;
;;------------------------------------------------------------;;
(setq cl:ratio 1.25 cl:app "LMAC_CL")
;;------------------------------------------------------------;;
(defun c:cl ( / _line ss e c r l1 l2 )
(if
(and
(setq ss
(ssget
(list '(0 . "CIRCLE") '(-4 . "<NOT") (list -3 (list cl:app)) '(-4 . "NOT>"))
)
)
(or (tblsearch "APPID" cl:app) (regapp cl:app))
)
(progn
(defun _line ( p1 p2 h )
(entmakex
(list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)
(list -3
(list cl:app
(cons 1002 "{") (cons 1005 h) (cons 1002 "}")
)
)
)
)
)
(repeat (setq i (sslength ss))
(setq e (entget (ssname ss (setq i (1- i))))
h (cdr (assoc 5 e))
c (cdr (assoc 10 e))
r (* cl:ratio (cdr (assoc 40 e)))
l1 (_line (polar c 0. r) (polar c pi r) h)
l2 (_line (polar c (/ pi 2.) r) (polar c (/ (* 3. pi) 2.) r) h)
)
(entmod
(list (assoc -1 e)
(list -3
(list cl:app
(cons 1002 "{")
(cons 1005 (cdr (assoc 5 (entget l1))))
(cons 1005 (cdr (assoc 5 (entget l2))))
(cons 1002 "}")
)
)
)
)
(vlr-object-reactor (list (vlax-ename->vla-object (cdr (assoc -1 e)))) (list cl:app h)
(list
(cons :vlr-modified 'cl:circle:callback)
)
)
(vlr-object-reactor (mapcar 'vlax-ename->vla-object (list l1 l2)) (list cl:app h)
(list
(cons :vlr-modified 'cl:line:callback)
)
)
)
)
)
(princ)
)
;;------------------------------------------------------------;;
(defun c:clremove ( / _massoc ss fl i e r d h x )
(defun _massoc ( x l )
(if (setq a (assoc x l))
(cons (cdr a) (_massoc x (cdr (member a l))))
)
)

(princ "\nSelect Circles to Remove Associativity <All>: ")
(setq fl (list '(0 . "CIRCLE") (list -3 (list cl:app))) i -1)

(if
(setq ss
(cond
( (ssget fl) )
( (ssget "_X" fl) )
)
)
(while (setq e (ssname ss (setq i (1+ i)))) (setq e (entget e (list cl:app)))
(foreach r (cdar (vlr-reactors :vlr-object-reactor))
(if
(and
(setq d (vlr-data r))
(listp d)
(eq cl:app (car d))
(or (not (cadr d)) (eq (cdr (assoc 5 e)) (cadr d)))
)
(vlr-remove r)
)
)
(foreach h (_massoc 1005 (cdadr (assoc -3 e)))
(if (setq x (entget (handent h)))
(entmod (list (assoc -1 x) (list -3 (list cl:app))))
)
)
(entmod (list (assoc -1 e) (list -3 (list cl:app))))
)
)
(princ)
)
;;------------------------------------------------------------;;
(defun cl:circle:callback ( owner reactor params / xtyp xval c r )
(if
(and
(vlax-read-enabled-p owner)
(progn (vla-getxdata owner cl:app 'xtyp 'xval) xval)
(setq
c (vlax-get owner 'center)
r (* cl:ratio (vlax-get owner 'radius))
)
)
(mapcar
(function
(lambda ( h a )
(if (or (entget (setq h (handent h))) (entdel h))
(entmod
(list (cons -1 h) (cons 10 (polar c a r)) (cons 11 (polar c (+ a pi) r)))
)
)
)
)
(cddr (mapcar 'vlax-variant-value (vlax-safearray->list xval))) (list 0. (/ pi 2.))
)
)
(princ)
)
;;------------------------------------------------------------;;
(defun cl:line:callback ( owner reactor params )
(setq *data (list owner reactor))
(vlr-command-reactor (list cl:app)
(list
(cons :vlr-commandended 'cl:line:modify)
(cons :vlr-commandcancelled 'cl:line:cancelled)
(cons :vlr-commandfailed 'cl:line:cancelled)
)
)
(vlr-remove reactor)
(princ)
)
;;------------------------------------------------------------;;
(defun cl:line:modify ( reactor params / xtyp xval h ) (vlr-remove reactor)
(if
(and *data (not (vlax-erased-p (car *data))) (progn (vla-getxdata (car *data) cl:app 'xtyp 'xval) xval)
(or
(entget
(setq h
(handent
(caddr
(mapcar 'vlax-variant-value (vlax-safearray->list xval))
)
)
)
)
(entdel h)
)
)
(progn
(cl:circle:callback (vlax-ename->vla-object h) nil nil)
(vlr-add (cadr *data))
(setq *data nil)
)
)
(princ)
)
;;------------------------------------------------------------;;
(defun cl:line:cancelled ( reactor params ) (vlr-remove reactor)
(if *data
(progn
(vlr-add (cadr *data))
(setq *data nil)
)
)
(princ)
)
;;------------------------------------------------------------;;
(
(lambda ( / r d s i e o xtyp xval )
(foreach r (cdar (vlr-reactors :vlr-object-reactor))
(if (and (setq d (vlr-data r)) (listp d) (eq cl:app (car d)))
(vlr-remove r)
)
)
(if (setq s (ssget "_X" (list '(0 . "CIRCLE") (list -3 (list cl:app)))))
(repeat (setq i (sslength s))
(setq e (ssname s (setq i (1- i))))
(vlr-object-reactor (list (setq o (vlax-ename->vla-object e))) (list cl:app (cdr (assoc 5 (entget e))))
(list
(cons :vlr-modified 'cl:circle:callback)
)
)
(vla-getxdata o cl:app 'xtyp 'xval) (setq xval (mapcar 'vlax-variant-value (vlax-safearray->list xval)))
(vlr-object-reactor
(mapcar
(function
(lambda ( h )
(or (entget (setq h (handent h))) (entdel h)) (vlax-ename->vla-object h)
)
)
(list (caddr xval) (cadddr xval))
)
(list cl:app (cdr (assoc 5 (entget e)))) (list (cons :vlr-modified 'cl:line:callback))
)
)
)
)
)
(vl-load-com) (princ)
;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;;

Mình viết đoạn code sau để mở Excel từ CAD nhưng vẫn chưa đạt theo yêu cầu:
- Nếu Excel đang mở thì thông báo tắt các Book cũ không liên quan và mở một Book mới để làm việc.
- Nếu Excel chưa mở thì mở Excel mới để làm việc.
Nhờ mọi người sửa giúp...

(defun C:OpenExcel (/ *ExcelApp% lst_data Cell& i)
(vl-load-com)
(setq *ExcelApp% (vlax-get-object...

Mình viết đoạn code sau để mở Excel từ CAD nhưng vẫn chưa đạt theo yêu cầu:
- Nếu Excel đang mở thì thông báo tắt các Book cũ không liên quan và mở một Book mới để làm việc.
- Nếu Excel chưa mở thì mở Excel mới để làm việc.
Nhờ mọi người sửa giúp...

(defun C:OpenExcel (/ *ExcelApp% lst_data Cell& i)
(vl-load-com)
(setq *ExcelApp% (vlax-get-object "Excel.Application"))
(if *ExcelApp%
(progn
(alert "Close all Excel spreadsheets to continue!")
)
(progn
(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
)
)
(vla-put-visible *ExcelApp% :vlax-true)
)

nhờ các cao thủ lsp sửa giúp mình cái lsp này với

(defun C:SD (/sel newpt ent edata elist)
(if (and
(setq sel (entsel "\nSelect Demension to Split."))
(setq newpt (getpoint "\Select new Dim Point"))
)
(progn
(setq ent (car sel)
edata (entget ent)
elist (vl-remove-if
'(lambda (pair)
(member
(car pair)
(list -1 2 5 102 310 300 330 331 340 350 350...

nhờ các cao thủ lsp sửa giúp mình cái lsp này với

(defun C:SD (/sel newpt ent edata elist)
(if (and
(setq sel (entsel "\nSelect Demension to Split."))
(setq newpt (getpoint "\Select new Dim Point"))
)
(progn
(setq ent (car sel)
edata (entget ent)
elist (vl-remove-if
'(lambda (pair)
(member
(car pair)
(list -1 2 5 102 310 300 330 331 340 350 350 410)
)
)
edata
)
)
(entmod
(subst (cons 14 newpt)
(assoc 14 elist)
)
)
(entmakex
(subst
(cons 13 newpt)
(assoc 13 elist)
elist
)
)
)
)
(princ "SplitDims")
)

1- Trước hết, xin nhắc bạn: LISP (viết tắt của LISt Processing - ngôn ngữ lập trình dựa trên cơ sở xử lý danh sách) chứ không phải SLIP!

2- Lisp theo yêu cầu của bạn đây:


Lệnh QSL, chọn khối 3dsolid, nhập các giá trị z1, z2, y1, y2 -> chương trình sẽ cắt bỏ tất cả và chỉ chừa lại khối solid cuối cùng như trong ví dụ của bạn (nếu bạn muốn giữ lại khối...

1- Trước hết, xin nhắc bạn: LISP (viết tắt của LISt Processing - ngôn ngữ lập trình dựa trên cơ sở xử lý danh sách) chứ không phải SLIP!

2- Lisp theo yêu cầu của bạn đây:


Lệnh QSL, chọn khối 3dsolid, nhập các giá trị z1, z2, y1, y2 -> chương trình sẽ cắt bỏ tất cả và chỉ chừa lại khối solid cuối cùng như trong ví dụ của bạn (nếu bạn muốn giữ lại khối nguyên thuỷ thì sao lưu nó trước khi thực hiện QSL), tính tổng diện tích xung quanh. Riêng thể tích thì bạn hãy dùng lệnh massprop, không nên lạm dụng lisp!

3- Nói thật lòng, mình không thích viết lisp này (không phải vì thiếu nhiệt tình). Ngoài những ý mà bạn Snowman đã nêu, dưới con mắt của của lập trình viên, "chất lượng chuyên môn" chứa trong các chương trình kiểu như thế này rất thấp. Mình đưa nó lên chỉ với mục đích minh hoạ cho ý kiến đã phát biểu "về cơ bản, những thao tác nào bạn có thể thực hiện bằng tay trực tiếp được với AutoCAD thì có thể thực hiện được bằng Lisp".

4- Yêu cầu của bạn có thể làm trực tiếp bằng các lệnh CAD có sẵn và cũng không mất nhiều thời gian. Bạn so sánh sẽ thấy, dùng lisp cũng không nhanh hơn được bao nhiêu.

5- Nhu cầu như trên của bạn thuộc dạng không thông dụng đối với nhiều người. Nếu thích, cách tốt nhất là bạn tự tìm hiểu lisp và tự lập trình cho mình. Ssg sẵn sàng hỗ trợ bạn học lisp trong khả năng của bản thân.

Mình có sưu tàm file lisp này dùng để khóa lisp;
Nhờ các anh hướng dẫn cho nội dung của lisp này và cách sử dụng


; pfc is stand for Password For Code
; Design by : Adesu <Ade Suharna>
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 13 July 2006
; Program no.: 0381/07/2006
; Edit by : Adesu 14/07/2006 1).
(defun...

Mình có sưu tàm file lisp này dùng để khóa lisp;
Nhờ các anh hướng dẫn cho nội dung của lisp này và cách sử dụng


; pfc is stand for Password For Code
; Design by : Adesu <Ade Suharna>
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 13 July 2006
; Program no.: 0381/07/2006
; Edit by : Adesu 14/07/2006 1).
(defun c:pfc (/ om ce current_date limit_date dcl_id ans key rk lim)
(setq *error* myer)
(setq om (getvar "osmode")) ; get osmode setting
(setvar "osmode" 0) ; osmode set to 0
(setq ce (getvar "cmdecho")) ; get cmdecho setting
(setvar "cmdecho" 0) ; cmdecho set to 0
(setq current_date (rtos (getvar "cdate") 2 0))
(setq limit_date "20060712")
(if
(< limit_date current_date)
(progn
(vl-load-com)
(*create_dialog*)
(setq dcl_id (load_dialog fname))
(if
(not (new_dialog "temp" dcl_id))
(exit)
) ; if
(set_tile "pw" " ")
(mode_tile "pw" 2)
(action_tile "ld" "(setq lim $value)") ; 1).
(action_tile "pw" "(setq pass $value)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ans (start_dialog))
(if
(= ans 0)
(progn
(alert (strcat "\nAre you sure to want try again"
"\nplease type pfc...and hit enter"))
(unload_dialog dcl_id)
(exit)
) ; progn
(progn
(setq key "Adesu")
(if
(= key pass)
(progn
(setq rk "HKEY_LOCAL_MACHINE\\SOFTWARE\\Autodesk\\AutoCAD\\R16.0\\ACAD-201:409\\Adesu_pfc")
(setq limit_date (atoi lim))
(vl-registry-write rk nil limit_date)
(setq limit_date (itoa (vl-registry-read rk)))
(alert (strcat "\nYou just resetting limit date"
"\nNew limit date is = "
limit_date))
) ; progn
(alert "\nInvalid enter code,your access denied")
) ; if
) ; progn
) ; if
) ; progn
(alert "\nPlease use this code,you are not yet blockade")
) ; if
(setvar "osmode" om) ; return setting
(setvar "cmdecho" ce) ; return setting
(setq *error* nil)
(princ)
) ; defun
(defun myer (msg)
(setvar "osmode" om)
(setvar "cmdecho" ce)
(setq att "***Resetting system variable was done***")
(princ att)
)
(defun *create_dialog* ()
(setq fname (vl-filename-mktemp "dcl.dcl"))
(setq fn (open fname "w"))
(write-line "temp : dialog {label = \"Password Protected\";
: text_part {label = \"Type..example 20060714\";}
: edit_box {label =\"Limit date\";
key = \"ld\";}
: text_part {label = \"Enter four digit code\";}
: edit_box {label = \"Password:\";
edit_width = 20;
key = \"pw\";
password_char = \"*\";}
ok_cancel;}" fn)
(close fn)
) ;defun


Rất cám ơn

Mọi người dùng thử lisp "Đo diện tích, xuât kết quả ra CAD và Excel" và đóng góp ý kiến nhé.
Cám ơn sự góp ý, đóng góp và code của các bạn Hà, Bình, Ketxu, tnmtpc...
- File Dien_tich_01.dcl

Dientich01 : dialog {
label = " *** - T&#221;nh Di&#214;n T&#221;ch Cho C&#184;c M&#198;t C&#190;t Ngang - Hec 13";
fixed_width = center;
: boxed_column {
: row {

>>

Mọi người dùng thử lisp "Đo diện tích, xuât kết quả ra CAD và Excel" và đóng góp ý kiến nhé.
Cám ơn sự góp ý, đóng góp và code của các bạn Hà, Bình, Ketxu, tnmtpc...
- File Dien_tich_01.dcl

Dientich01 : dialog {
label = " *** - T&#221;nh Di&#214;n T&#221;ch Cho C&#184;c M&#198;t C&#190;t Ngang - Hec 13";
fixed_width = center;
: boxed_column {
: row {
fixed_width = true;
children_alignment = centered;
: edit_box {
label = "Ti Le Ve MCN:";
key = "tle";
edit_width = 6;
edit_height = 1;
}
: edit_box {
label = "Ten Mat Cat:";
fixed_width = true;
key = "ten";
edit_width = 6;
edit_height = 1;
}
: edit_box {
label = "Khoang Cach C.Don:";
fixed_width = true;
key = "cdon";
edit_width = 6;
edit_height = 1;
}
}
}
:spacer { height=0.5; }
//-----------------------------
: boxed_column {
label = "-------------Thanh Phan - Hang Muc Tinh Dien Tich:";
: row {
fixed_width = true;
children_alignment = Right;
: toggle {
key = "t1";
mnemonic = "b";
value = "0";
}
: edit_box {
label = "S";
key = "e1";
edit_width = 30;
}
: text {
label = "= ";
key = "s1";
edit_width = 100;
}
: button {
label = "Pick" ;
is_default = true ;
key = "p1" ;
width = 26;
}
}
//-----------------------------
: row {
fixed_width = true;
children_alignment = Right;
: toggle {
key = "t2";
mnemonic = "b";
value = "0";
}
: edit_box {
label = "S";
key = "e2";
edit_width = 30;
}
: text {
label = "= ";
key = "s2";
edit_width = 100;
}
: button {
label = "Pick" ;
is_default = true ;
key = "p2" ;
width = 26;
}
}
//-----------------------------
: row {
fixed_width = true;
children_alignment = Right;
: toggle {
key = "t3";
mnemonic = "b";
value = "0";
}
: edit_box {
label = "S";
key = "e3";
edit_width = 30;
}
: text {
label = "= ";
key = "s3";
edit_width = 100;
}
: button {
label = "Pick" ;
is_default = true ;
key = "p3" ;
width = 26;
}
}
//-----------------------------
: row {
fixed_width = true;
children_alignment = Right;
: toggle {
key = "t4";
mnemonic = "b";
value = "0";
}
: edit_box {
label = "S";
key = "e4";
edit_width = 30;
}
: text {
label = "= ";
key = "s4";
edit_width = 100;
}
: button {
label = "Pick" ;
is_default = true ;
key = "p4" ;
width = 26;
}
}
//-----------------------------
: row {
fixed_width = true;
children_alignment = Right;
: toggle {
key = "t5";
mnemonic = "b";
value = "0";
}
: edit_box {
label = "S";
key = "e5";
edit_width = 30;
}
: text {
label = "= ";
key = "s5";
edit_width = 100;
}
: button {
label = "Pick" ;
is_default = true ;
key = "p5" ;
width = 26;
}
}
//-----------------------------
: row {
fixed_width = true;
children_alignment = Right;
: toggle {
key = "t6";
mnemonic = "b";
value = "0";
}
: edit_box {
label = "S";
key = "e6";
edit_width = 30;
}
: text {
label = "= ";
key = "s6";
edit_width = 100;
}
: button {
label = "Pick" ;
is_default = true ;
key = "p6" ;
width = 26;
}
}
//-----------------------------
: row {
fixed_width = true;
children_alignment = Right;
: toggle {
key = "t7";
mnemonic = "b";
value = "0";
}
: edit_box {
label = "S";
key = "e7";
edit_width = 30;
}
: text {
label = "= ";
key = "s7";
edit_width = 100;
}
: button {
label = "Pick" ;
is_default = true ;
key = "p7" ;
width = 26;
}
}
//-----------------------------
: row {
fixed_width = true;
children_alignment = Right;
: toggle {
key = "t8";
mnemonic = "b";
value = "0";
}
: edit_box {
label = "S";
key = "e8";
edit_width = 30;
}
: text {
label = "= ";
key = "s8";
edit_width = 100;
}
: button {
label = "Pick" ;
is_default = true ;
key = "p8" ;
width = 26;
}
}
//-----------------------------
: row {
fixed_width = true;
children_alignment = Right;
: toggle {
key = "t9";
mnemonic = "b";
value = "0";
}
: edit_box {
label = "S";
key = "e9";
edit_width = 30;
}
: text {
label = "= ";
key = "s9";
edit_width = 100;
}
: button {
label = "Pick" ;
is_default = true ;
key = "p9" ;
width = 26;
}
}
//-----------------------------
: row {
fixed_width = true;
children_alignment = Right;
: toggle {
key = "t10";
mnemonic = "b";
value = "0";
}
: edit_box {
label = "S";
key = "e10";
edit_width = 30;
}
: text {
label = "= ";
key = "s10";
edit_width = 100;
}
: button {
label = "Pick" ;
is_default = true ;
key = "p10" ;
width = 26;
}
}
}
//-----------------------------
: row {
fixed_height = true;
children_alignment = centered;
: spacer { height=3; }
// : spacer { width=3; }
: button {
label = "Xuat sang Excel" ;
is_default = true ;
key = "excel" ;
width = 20;
}
: button {
label = "OK" ;
is_default = true ;
key = "start" ;
width = 20;
}
: button {
label = "Cancel" ;
width = 20;
is_cancel= true ;
}
// : text_part { label = "paragraph 1"; }
// : paragraph {
// : text_part { label = "paragraph 1"; }
// : spacer { height=0.1; }
// : text_part { label = "paragraph 2"; }
// : text_part { label = "paragraph 3"; }
// }
// : paragraph {
// : concatenation {
// : text_part {label = "column 1";}
// : text_part {label = "column 2";}
// : text_part {label = "column 3";}
// }
// }
:spacer { height=0.1; }
}
}

- File lisp:

;---------Tinh Dien Tich Dao, Dap (Cho M.cat) - dientich-01
;**********************************************************
(defun Get_tle (/ g:tle)
(set_tile "error" "")
(setq g:tle (get_tile "tle"))
(setq tle (atof g:tle))
)
;------------------------------------------
(defun Get_ten (/ g:ten)
(set_tile "error" "")
(setq g:ten (get_tile "ten"))
(setq ten g:ten)
)
;------------------------------------------
(defun Get_cdon (/ g:cdon)
(set_tile "error" "")
(setq g:cdon (get_tile "cdon"))
(setq cdon (atof g:cdon))
)
;------------------------------------------
;------------------------------------------
(defun Get_t1()
(set_tile "error" "")
(setq g:t1 (get_tile "t1"))
(setq t1 g:t1)
(cond
((= g:t1 "1")
(mode_tile "e1" 0)
(mode_tile "s1" 0)
(mode_tile "p1" 0)
)
(T
(mode_tile "e1" 1)
(mode_tile "s1" 1)
(mode_tile "p1" 1)
(set_tile "e1" (setq g:e1 ""))
(set_tile "s1" (STRCAT "= " (setq g:s1 (rtos 0.0 2 3)) " m2"))
)
)
)
;------------------------------------------
(defun Get_t2()
(set_tile "error" "")
(setq g:t2 (get_tile "t2"))
(setq t2 g:t2)
(cond
((= g:t2 "1")
(mode_tile "e2" 0)
(mode_tile "s2" 0)
(mode_tile "p2" 0)
)
(T
(mode_tile "e2" 1)
(mode_tile "s2" 1)
(mode_tile "p2" 1)
(set_tile "e2" (setq g:e2 ""))
(set_tile "s2" (STRCAT "= " (setq g:s2 (rtos 0.0 2 3)) " m2"))
)
)
)
;------------------------------------------
(defun Get_t3()
(set_tile "error" "")
(setq g:t3 (get_tile "t3"))
(setq t3 g:t3)
(cond
((= g:t3 "1")
(mode_tile "e3" 0)
(mode_tile "s3" 0)
(mode_tile "p3" 0)
)
(T
(mode_tile "e3" 1)
(mode_tile "s3" 1)
(mode_tile "p3" 1)
(set_tile "e3" (setq g:e3 ""))
(set_tile "s3" (STRCAT "= " (setq g:s3 (rtos 0.0 2 3)) " m2"))
)
)
)
;------------------------------------------
(defun Get_t4()
(set_tile "error" "")
(setq g:t4 (get_tile "t4"))
(setq t4 g:t4)
(cond
((= g:t4 "1")
(mode_tile "e4" 0)
(mode_tile "s4" 0)
(mode_tile "p4" 0)
)
(T
(mode_tile "e4" 1)
(mode_tile "s4" 1)
(mode_tile "p4" 1)
(set_tile "e4" (setq g:e4 ""))
(set_tile "s4" (STRCAT "= " (setq g:s4 (rtos 0.0 2 3)) " m2"))
)
)
)
;------------------------------------------
(defun Get_t5()
(set_tile "error" "")
(setq g:t5 (get_tile "t5"))
(setq t5 g:t5)
(cond
((= g:t5 "1")
(mode_tile "e5" 0)
(mode_tile "s5" 0)
(mode_tile "p5" 0)
)
(T
(mode_tile "e5" 1)
(mode_tile "s5" 1)
(mode_tile "p5" 1)
(set_tile "e5" (setq g:e5 ""))
(set_tile "s5" (STRCAT "= " (setq g:s5 (rtos 0.0 2 3)) " m2"))
)
)
)
;------------------------------------------
(defun Get_t6()
(set_tile "error" "")
(setq g:t6 (get_tile "t6"))
(setq t6 g:t6)
(cond
((= g:t6 "1")
(mode_tile "e6" 0)
(mode_tile "s1" 0)
(mode_tile "p6" 0)
)
(T
(mode_tile "e6" 1)
(mode_tile "s6" 1)
(mode_tile "p6" 1)
(set_tile "e6" (setq g:e6 ""))
(set_tile "s6" (STRCAT "= " (setq g:s6 (rtos 0.0 2 3)) " m2"))
)
)
)
;------------------------------------------
(defun Get_t7()
(set_tile "error" "")
(setq g:t7 (get_tile "t7"))
(setq t7 g:t7)
(cond
((= g:t7 "1")
(mode_tile "e7" 0)
(mode_tile "s7" 0)
(mode_tile "p7" 0)
)
(T
(mode_tile "e7" 1)
(mode_tile "s7" 1)
(mode_tile "p7" 1)
(set_tile "e7" (setq g:e7 ""))
(set_tile "s7" (STRCAT "= " (setq g:s7 (rtos 0.0 2 3)) " m2"))
)
)
)
;------------------------------------------
(defun Get_t8()
(set_tile "error" "")
(setq g:t8 (get_tile "t8"))
(setq t8 g:t8)
(cond
((= g:t8 "1")
(mode_tile "e8" 0)
(mode_tile "s8" 0)
(mode_tile "p8" 0)
)
(T
(mode_tile "e8" 1)
(mode_tile "s8" 1)
(mode_tile "p8" 1)
(set_tile "e8" (setq g:e8 ""))
(set_tile "s8" (STRCAT "= " (setq g:s8 (rtos 0.0 2 3)) " m2"))
)
)
)
;------------------------------------------
(defun Get_t9()
(set_tile "error" "")
(setq g:t9 (get_tile "t9"))
(setq t9 g:t9)
(cond
((= g:t9 "1")
(mode_tile "e9" 0)
(mode_tile "s9" 0)
(mode_tile "p9" 0)
)
(T
(mode_tile "e9" 1)
(mode_tile "s9" 1)
(mode_tile "p9" 1)
(set_tile "e9" (setq g:e9 ""))
(set_tile "s9" (STRCAT "= " (setq g:s9 (rtos 0.0 2 3)) " m2"))
)
)
)
;------------------------------------------
(defun Get_t10()
(set_tile "error" "")
(setq g:t10 (get_tile "t10"))
(setq t10 g:t10)
(cond
((= g:t10 "1")
(mode_tile "e10" 0)
(mode_tile "s10" 0)
(mode_tile "p10" 0)
)
(T
(mode_tile "e10" 1)
(mode_tile "s10" 1)
(mode_tile "p10" 1)
(set_tile "e10" (setq g:e10 ""))
(set_tile "s10" (STRCAT "= " (setq g:s10 (rtos 0.0 2 3)) " m2"))
)
)
)
;------------------------------------------
;------------------------------------------
(defun Get_e1()
(set_tile "error" "")
(setq g:e1 (get_tile "e1"))
(setq e1 g:e1)
)
;------------------------------------------
(defun Get_e2()
(set_tile "error" "")
(setq g:e2 (get_tile "e2"))
(setq e2 g:e2)
)
;------------------------------------------
(defun Get_e3()
(set_tile "error" "")
(setq g:e3 (get_tile "e3"))
(setq e3 g:e3)
)
;------------------------------------------
(defun Get_e4()
(set_tile "error" "")
(setq g:e4 (get_tile "e4"))
(setq e4 g:e4)
)
;------------------------------------------
(defun Get_e5()
(set_tile "error" "")
(setq g:e5 (get_tile "e5"))
(setq e5 g:e5)
)
;------------------------------------------
(defun Get_e6()
(set_tile "error" "")
(setq g:e6 (get_tile "e6"))
(setq e6 g:e6)
)
;------------------------------------------
(defun Get_e7()
(set_tile "error" "")
(setq g:e7 (get_tile "e7"))
(setq e7 g:e7)
)
;------------------------------------------
(defun Get_e8()
(set_tile "error" "")
(setq g:e8 (get_tile "e8"))
(setq e8 g:e8)
)
;------------------------------------------
(defun Get_e9()
(set_tile "error" "")
(setq g:e9 (get_tile "e9"))
(setq e9 g:e9)
)
;------------------------------------------
(defun Get_e10()
(set_tile "error" "")
(setq g:e10 (get_tile "e10"))
(setq e10 g:e10)
)
;------------------------------------------
;------------------------------------------
(defun Get_p1()
(set_tile "error" "")
(dientich)
; (alert (strcat "\n tri so g:btct = " g:btct))
)
;------------------------------------------
(defun Get_p2()
(set_tile "error" "")
(dientich)
)
;------------------------------------------
(defun Get_p3()
(set_tile "error" "")
(dientich)
)
;------------------------------------------
(defun Get_p4()
(set_tile "error" "")
(dientich)
)
;------------------------------------------
(defun Get_p5()
(set_tile "error" "")
(dientich)
)
;------------------------------------------
(defun Get_p6()
(set_tile "error" "")
(dientich)
)
;------------------------------------------
(defun Get_p7()
(set_tile "error" "")
(dientich)
)
;------------------------------------------
(defun Get_p8()
(set_tile "error" "")
(dientich)
)
;------------------------------------------
(defun Get_p9()
(set_tile "error" "")
(dientich)
)
;------------------------------------------
(defun Get_p10()
(set_tile "error" "")
(dientich)
)
;------------------------------------------
;;;mode_tile - 0 = an (Tat), 1 = Hien (mo)
;------------------------------------------
(defun Setloc()
(if (not tle) (setq tle 50.0))
(set_tile "tle" (setq g:tle (rtos tle 2 0)))

(if (not ten) (setq ten "A-A"))
(set_tile "ten" (setq g:ten ten))

(if (not cdon) (setq cdon 0.0))
(set_tile "cdon" (setq g:cdon (rtos cdon 2 2)))

(if (not e1) (setq e1 ""))
(set_tile "e1" (setq g:e1 e1))

(if (not e2) (setq e2 ""))
(set_tile "e2" (setq g:e2 e2))

(if (not e3) (setq e3 ""))
(set_tile "e3" (setq g:e3 e3))

(if (not e4) (setq e4 ""))
(set_tile "e4" (setq g:e4 e4))

(if (not e5) (setq e5 ""))
(set_tile "e5" (setq g:e5 e5))

(if (not e6) (setq e6 ""))
(set_tile "e6" (setq g:e6 e6))

(if (not e7) (setq e7 ""))
(set_tile "e7" (setq g:e7 e7))

(if (not e8) (setq e8 ""))
(set_tile "e8" (setq g:e8 e8))

(if (not e9) (setq e9 ""))
(set_tile "e9" (setq g:e9 e9))

(if (not e10) (setq e10 ""))
(set_tile "e10" (setq g:e10 e10))

(if (not dt1) (setq dt1 0.0))
(set_tile "s1" (STRCAT "= " (setq g:s1 (rtos dt1 2 3)) " m2"))

(if (not dt2) (setq dt2 0.0))
(set_tile "s2" (STRCAT "= " (setq g:s2 (rtos dt2 2 3)) " m2"))

(if (not dt3) (setq dt3 0.0))
(set_tile "s3" (STRCAT "= " (setq g:s3 (rtos dt3 2 3)) " m2"))

(if (not dt4) (setq dt4 0.0))
(set_tile "s4" (STRCAT "= " (setq g:s4 (rtos dt4 2 3)) " m2"))

(if (not dt5) (setq dt5 0.0))
(set_tile "s5" (STRCAT "= " (setq g:s5 (rtos dt5 2 3)) " m2"))

(if (not dt6) (setq dt6 0.0))
(set_tile "s6" (STRCAT "= " (setq g:s6 (rtos dt6 2 3)) " m2"))

(if (not dt7) (setq dt7 0.0))
(set_tile "s7" (STRCAT "= " (setq g:s7 (rtos dt7 2 3)) " m2"))

(if (not dt8) (setq dt8 0.0))
(set_tile "s8" (STRCAT "= " (setq g:s8 (rtos dt8 2 3)) " m2"))

(if (not dt9) (setq dt9 0.0))
(set_tile "s9" (STRCAT "= " (setq g:s9 (rtos dt9 2 3)) " m2"))

(if (not dt10) (setq dt10 0.0))
(set_tile "s10" (STRCAT "= " (setq g:s10 (rtos dt10 2 3)) " m2"))
(if (not g:t1) (setq g:t1 "1"))
(set_tile "t1" g:t1)
(cond
((= g:t1 "1")
(mode_tile "e1" 0)
(mode_tile "s1" 0)
(mode_tile "p1" 0)
)
(T
(mode_tile "e1" 1)
(mode_tile "s1" 1)
(mode_tile "p1" 1)
)
)
(if (not g:t2) (setq g:t2 "0"))
(set_tile "t2" g:t2)
(cond
((= g:t2 "1")
(mode_tile "e2" 0)
(mode_tile "s2" 0)
(mode_tile "p2" 0)
)
(T
(mode_tile "e2" 1)
(mode_tile "s2" 1)
(mode_tile "p2" 1)
)
)
(if (not g:t3) (setq g:t3 "0"))
(set_tile "t3" g:t3)
(cond
((= g:t3 "1")
(mode_tile "e3" 0)
(mode_tile "s3" 0)
(mode_tile "p3" 0)
)
(T
(mode_tile "e3" 1)
(mode_tile "s3" 1)
(mode_tile "p3" 1)
)
)
(if (not g:t4) (setq g:t4 "0"))
(set_tile "t4" g:t4)
(cond
((= g:t4 "1")
(mode_tile "e4" 0)
(mode_tile "s4" 0)
(mode_tile "p4" 0)
)
(T
(mode_tile "e4" 1)
(mode_tile "s4" 1)
(mode_tile "p4" 1)
)
)
(if (not g:t5) (setq g:t5 "0"))
(set_tile "t5" g:t5)
(cond
((= g:t5 "1")
(mode_tile "e5" 0)
(mode_tile "s5" 0)
(mode_tile "p5" 0)
)
(T
(mode_tile "e5" 1)
(mode_tile "s5" 1)
(mode_tile "p5" 1)
)
)
(if (not g:t6) (setq g:t6 "0"))
(set_tile "t6" g:t6)
(cond
((= g:t6 "1")
(mode_tile "e6" 0)
(mode_tile "s1" 0)
(mode_tile "p6" 0)
)
(T
(mode_tile "e6" 1)
(mode_tile "s6" 1)
(mode_tile "p6" 1)
)
)
(if (not g:t7) (setq g:t7 "0"))
(set_tile "t7" g:t7)
(cond
((= g:t7 "1")
(mode_tile "e7" 0)
(mode_tile "s7" 0)
(mode_tile "p7" 0)
)
(T
(mode_tile "e7" 1)
(mode_tile "s7" 1)
(mode_tile "p7" 1)
)
)
(if (not g:t8) (setq g:t8 "0"))
(set_tile "t8" g:t8)
(cond
((= g:t8 "1")
(mode_tile "e8" 0)
(mode_tile "s8" 0)
(mode_tile "p8" 0)
)
(T
(mode_tile "e8" 1)
(mode_tile "s8" 1)
(mode_tile "p8" 1)
)
)
(if (not g:t9) (setq g:t9 "0"))
(set_tile "t9" g:t9)
(cond
((= g:t9 "1")
(mode_tile "e9" 0)
(mode_tile "s9" 0)
(mode_tile "p9" 0)
)
(T
(mode_tile "e9" 1)
(mode_tile "s9" 1)
(mode_tile "p9" 1)
)
)
(if (not g:t10) (setq g:t10 "0"))
(set_tile "t10" g:t10)
(cond
((= g:t10 "1")
(mode_tile "e10" 0)
(mode_tile "s10" 0)
(mode_tile "p10" 0)
)
(T
(mode_tile "e10" 1)
(mode_tile "s10" 1)
(mode_tile "p10" 1)
)
)
)
;---------------
(defun Restore()
(command "LUPREC" 2 "color" "bylayer" "osmode" 97)
(setq *ERROR* Olderr)
(setvar "BLIPMODE" Oldblp) (setvar "CMDECHO" Oldech)
(setvar "PICKBOX" 4) (setvar "DIMZIN" 8)
)
;----------------------------------------------------------------------------
(defun C:dientich-01 (/ Oldblp Oldech Olderr Dial nhim What_next ten cdon sdo
t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 s1 s2 s3 s4 s5 s6 s7 s8 s9 s10
p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 dt1 dt2 dt3 dt4 dt5 dt6 dt7 dt8 dt9 dt10
g:e1 g:e2 g:e3 g:e4 g:e5 g:e6 g:e7 g:e8 g:e9 g:e10
g:s1 g:s2 g:s3 g:s4 g:s5 g:s6 g:s7 g:s8 g:s9 g:s10)
(setq Oldblp (getvar "BLIPMODE") Oldech (getvar "CMDECHO") Olderr *ERROR*)
(setvar "BLIPMODE" 0) (setvar "DIMZIN" 0) (setvar "PICKBOX" 0) (setvar "CMDECHO" 0)
(COMMAND "LUPREC" 4 "osnap" "None" "UCS" "W")
;----------------------------------------------
(defun *ERROR* (Msg)
(princ "\nError: ") (princ Msg)
(unload_dialog Dial)
(Restore)
(princ)
)
;---------------------------------------------
(setq Dial (load_dialog "Dien_tich_01.DCL"))
(setq What_next 2)
(while (> What_next 1)
(if (not (new_dialog "Dientich01" Dial))
(progn (Restore) (exit))
)
(Setloc)
(action_tile "tle" "(Get_tle)")
(action_tile "ten" "(Get_ten)")
(action_tile "cdon" "(Get_cdon)")

(action_tile "t1" "(Get_t1)")
(action_tile "t2" "(Get_t2)")
(action_tile "t3" "(Get_t3)")
(action_tile "t4" "(Get_t4)")
(action_tile "t5" "(Get_t5)")
(action_tile "t6" "(Get_t6)")
(action_tile "t7" "(Get_t7)")
(action_tile "t8" "(Get_t8)")
(action_tile "t9" "(Get_t9)")
(action_tile "t10" "(Get_t10)")

(action_tile "e1" "(Get_e1)")
(action_tile "e2" "(Get_e2)")
(action_tile "e3" "(Get_e3)")
(action_tile "e4" "(Get_e4)")
(action_tile "e5" "(Get_e5)")
(action_tile "e6" "(Get_e6)")
(action_tile "e7" "(Get_e7)")
(action_tile "e8" "(Get_e8)")
(action_tile "e9" "(Get_e9)")
(action_tile "e10" "(Get_e10)")

(action_tile "p1" "(done_dialog 2)")
(action_tile "p2" "(done_dialog 3)")
(action_tile "p3" "(done_dialog 4)")
(action_tile "p4" "(done_dialog 5)")
(action_tile "p5" "(done_dialog 6)")
(action_tile "p6" "(done_dialog 7)")
(action_tile "p7" "(done_dialog 8)")
(action_tile "p8" "(done_dialog 9)")
(action_tile "p9" "(done_dialog 10)")
(action_tile "p10" "(done_dialog 11)")
(action_tile "excel" "(done_dialog 12)")
(action_tile "Accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq What_next (start_dialog))
(cond
((= What_next 1) (Go))
((= What_next 2) (Get_p1))
((= What_next 3) (Get_p2))
((= What_next 4) (Get_p3))
((= What_next 5) (Get_p4))
((= What_next 6) (Get_p5))
((= What_next 7) (Get_p6))
((= What_next 8) (Get_p7))
((= What_next 9) (Get_p8))
((= What_next 10) (Get_p9))
((= What_next 11) (Get_p10))
((= What_next 12) (WriteToExcel))
)
)
(unload_dialog Dial)
(Restore)
(princ)
)
;;;--------------------------------------------------------------
(defun dientich (/ bli cmd E Eo En do diem s oldcolor nam Enam)
(setq do nil s nil Ename (ssadd))
(setq E "P") (initget 128 "P S")
(setq Eo (getkword "\nSelect Entity or Pick Point (S/<P>) : "))
(if Eo (setq E Eo))
(cond
((= E "P")
(command "color" 112 "linetype" "S" "hidden" "" "osmode" 0)
(while
(setq diem (getpoint "\n Pick point...(<Retern> to end) :"))
(command "boundary" diem "" "area" "E" "L")
(setq s (getvar "area"))
(setq do (cons s do))
(setq name (entlast))
(setq Ename (ssadd name Ename))
)
(setq Sdo (eval (cons + do)))
(command "erase" Ename "" "color" "Bylayer" "linetype" "S" "continuous" "")
)
(T
(setq En (ssget))
(command "area" "E" En)
(setq Sdo (getvar "area"))
)
)
(setq tile (/ tle 100))
(cond
((= What_next 2) (setq dt1 (* Sdo tile tile)))
((= What_next 3) (setq dt2 (* Sdo tile tile)))
((= What_next 4) (setq dt3 (* Sdo tile tile)))
((= What_next 5) (setq dt4 (* Sdo tile tile)))
((= What_next 6) (setq dt5 (* Sdo tile tile)))
((= What_next 7) (setq dt6 (* Sdo tile tile)))
((= What_next 8) (setq dt7 (* Sdo tile tile)))
((= What_next 9) (setq dt8 (* Sdo tile tile)))
((= What_next 10) (setq dt9 (* Sdo tile tile)))
((= What_next 11) (setq dt10 (* Sdo tile tile)))
)
)
;;;--------------------------------------------------------------
(defun Go (/ p Enam Ena m n)
(SETQ P (GETPOINT "\nStart point...: "))
(setq oblist (ssadd))
(if (> dt1 0)
(progn
(command "text" "J" "R" p "0" (strcat "S " e1 " (m2) ="))
; (setq obl (entlast) oblist (ssadd obl oblist))
(command "text" (polar p 0.0 (getvar "Textsize")) "0" (rtos dt1 2 3))
; (setq obl (entlast) oblist (ssadd obl oblist))
; (command "attdef" "" e1 e1 dt1 (polar p 0.0 (getvar "Textsize")) "")
; (setq obl (entlast) oblist (ssadd obl oblist))
(setq p (polar p (- (/ pi 2)) (* (getvar "Textsize") 2.0)))
)
)
(if (> dt2 0)
(progn
(command "text" "J" "R" p "0" (strcat "S " e2 " (m2) ="))
(command "text" (polar p 0.0 (getvar "Textsize")) "0" (rtos dt2 2 3))
(setq p (polar p (- (/ pi 2)) (* (getvar "Textsize") 2.0)))
)
)
(if (> dt3 0)
(progn
(command "text" "J" "R" p "0" (strcat "S " e3 " (m2) ="))
(command "text" (polar p 0.0 (getvar "Textsize")) "0" (rtos dt3 2 3))
(setq p (polar p (- (/ pi 2)) (* (getvar "Textsize") 2.0)))
)
)
(if (> dt4 0)
(progn
(command "text" "J" "R" p "0" (strcat "S " e4 " (m2) ="))
(command "text" (polar p 0.0 (getvar "Textsize")) "0" (rtos dt4 2 3))
(setq p (polar p (- (/ pi 2)) (* (getvar "Textsize") 2.0)))
)
)
(if (> dt5 0)
(progn
(command "text" "J" "R" p "0" (strcat "S " e5 " (m2) ="))
(command "text" (polar p 0.0 (getvar "Textsize")) "0" (rtos dt5 2 3))
(setq p (polar p (- (/ pi 2)) (* (getvar "Textsize") 2.0)))
)
)
(if (> dt6 0)
(progn
(command "text" "J" "R" p "0" (strcat "S " e6 " (m2) ="))
(command "text" (polar p 0.0 (getvar "Textsize")) "0" (rtos dt6 2 3))
(setq p (polar p (- (/ pi 2)) (* (getvar "Textsize") 2.0)))
)
)
(if (> dt7 0)
(progn
(command "text" "J" "R" p "0" (strcat "S " e7 " (m2) ="))
(command "text" (polar p 0.0 (getvar "Textsize")) "0" (rtos dt7 2 3))
(setq p (polar p (- (/ pi 2)) (* (getvar "Textsize") 2.0)))
)
)
(if (> dt8 0)
(progn
(command "text" "J" "R" p "0" (strcat "S " e8 " (m2) ="))
(command "text" (polar p 0.0 (getvar "Textsize")) "0" (rtos dt8 2 3))
(setq p (polar p (- (/ pi 2)) (* (getvar "Textsize") 2.0)))
)
)
(if (> dt9 0)
(progn
(command "text" "J" "R" p "0" (strcat "S " e9 " (m2) ="))
(command "text" (polar p 0.0 (getvar "Textsize")) "0" (rtos dt9 2 3))
(setq p (polar p (- (/ pi 2)) (* (getvar "Textsize") 2.0)))
)
)
(if (> dt10 0)
(progn
(command "text" "J" "R" p "0" (strcat "S " e10 " (m2) ="))
(command "text" (polar p 0.0 (getvar "Textsize")) "0" (rtos dt10 2 3))
(setq p (polar p (- (/ pi 2)) (* (getvar "Textsize") 2.0)))
)
)
; (command "Block" "Du" "Y" p oblist "")
(setq Enam (ssget "X" '((0 . "LWPOLYLINE") (62 . 112) (6 . "HIDDEN"))))
(setq m 0)
(repeat (sslength Enam)
(setq Ena (ssname Enam m))
(command "_erase" Ena "")
(setq m (+ m 1))
)
(COMMAND "LUPREC" 4 "osmode" 33 "linetype" "S" "Continuous" "" "OOPS")
)
;;;-----------------------------------------------------------------------------
(defun WriteToExcel (/ *ExcelApp% lst_data cviec Cell& i)
(setq lst_data '() cviec '())
(setq lst_data (cons ten lst_data) lst_data (cons (rtos cdon 2 2) lst_data))
(if (> dt1 0) (setq lst_data (cons (rtos dt1 2 3) lst_data)))
(if (> dt2 0) (setq lst_data (cons (rtos dt2 2 3) lst_data)))
(if (> dt3 0) (setq lst_data (cons (rtos dt3 2 3) lst_data)))
(if (> dt4 0) (setq lst_data (cons (rtos dt4 2 3) lst_data)))
(if (> dt5 0) (setq lst_data (cons (rtos dt5 2 3) lst_data)))
(if (> dt6 0) (setq lst_data (cons (rtos dt6 2 3) lst_data)))
(if (> dt7 0) (setq lst_data (cons (rtos dt7 2 3) lst_data)))
(if (> dt8 0) (setq lst_data (cons (rtos dt8 2 3) lst_data)))
(if (> dt9 0) (setq lst_data (cons (rtos dt9 2 3) lst_data)))
(if (> dt10 0) (setq lst_data (cons (rtos dt10 2 3) lst_data)))
(setq lst_data (reverse lst_data))

(setq cviec (cons "M.Cat" cviec) cviec (cons "C.Don" cviec))
(if (> dt1 0) (setq cviec (cons e1 cviec)))
(if (> dt2 0) (setq cviec (cons e2 cviec)))
(if (> dt3 0) (setq cviec (cons e3 cviec)))
(if (> dt4 0) (setq cviec (cons e4 cviec)))
(if (> dt5 0) (setq cviec (cons e5 cviec)))
(if (> dt6 0) (setq cviec (cons e6 cviec)))
(if (> dt7 0) (setq cviec (cons e7 cviec)))
(if (> dt8 0) (setq cviec (cons e8 cviec)))
(if (> dt9 0) (setq cviec (cons e9 cviec)))
(if (> dt10 0) (setq cviec (cons e10 cviec)))
(setq cviec (reverse cviec))
(vl-load-com)
(if
(or
(not (setq *ExcelApp% (vlax-get-object "Excel.Application")))
(= (vla-get-visible *ExcelApp%) :vlax-false)
)
(progn
(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
(vla-put-visible *ExcelApp% :vlax-true)
)
)
(setq i 1)
(while (/= (getcell (strcat "A" (itoa i))) "")
(setq i (1+ i))
)
; (alert (strcat "So dong hien tai: " (rtos i 2 0)))
(setq Cell& (strcat "A" (itoa i)))
(putcell Cell& cviec)
(setq Cell& (strcat "A" (itoa (+ i 1))))
(putcell Cell& lst_data)
)
;-------------------------------------------------------------------------------
; GetCell - Returns the cell value from the *ExcelData@ list
; Arguments: 1
; Cell$ = Cell ID
; Syntax example: (GetCell "E19") = value of cell E19
;-------------------------------------------------------------------------------
(defun GetCell (Cell$ / ExcelRange^ ExcelVariant^ )
(setq ExcelRange^ (vlax-get-property *ExcelApp% "Range" Cell$))
(setq ExcelVariant^ (vlax-get-property ExcelRange^ 'Value))
(setq ExcelValue (vlax-variant-value ExcelVariant^))
(setq ExcelValue
(cond
((= (type ExcelValue) 'INT) (itoa ExcelValue))
((= (type ExcelValue) 'REAL) (rtosr ExcelValue))
((= (type ExcelValue) 'STR) (vl-string-trim " " ExcelValue))
((/= (type ExcelValue) 'STR) "")
);cond
);setq
ExcelValue
);defun GetCell
;-------------------------------------------------------------------------------
; PutCell - Put values into Excel cells
; Arguments: 2
; StartCell$ = Starting Cell ID
; Data@ = Value or list of values
; Syntax examples:
; (PutCell "A1" "PART NUMBER") = Puts PART NUMBER in cell A1
; (PutCell "B3" '("Dim" 7.5 "9.75")) = Starting with cell B3 put Dim, 7.5, and 9.75 across
;-------------------------------------------------------------------------------
(defun PutCell (StartCell$ Data@ / Cell$ Column# ExcelRange Row#)
(if (= (type Data@) 'STR)
(setq Data@ (list Data@))
)
(setq ExcelRange (vlax-get-property *ExcelApp% "Cells"))
(if (Cell-p StartCell$)
(setq Column# (car (ColumnRow StartCell$))
Row# (cadr (ColumnRow StartCell$))
);setq
(if (vl-catch-all-error-p
(setq Cell$ (vl-catch-all-apply 'vlax-get-property
(list (vlax-get-property *ExcelApp% "ActiveSheet") "Range" StartCell$))
);setq
);vl-catch-all-error-p
(alert (strcat "The cell ID \"" StartCell$ "\" is invalid."))
(setq Column# (vlax-get-property Cell$ "Column")
Row# (vlax-get-property Cell$ "Row")
);setq
);if
);if
(if (and Column# Row#)
(foreach Item Data@
(vlax-put-property ExcelRange "Item" Row# Column# (vl-princ-to-string Item))
(setq Column# (1+ Column#))
);foreach
);if
(princ)
);defun PutCell
;-------------------------------------------------------------------------------
(defun ColumnRow (Cell$ / Column$ Char$ Row#)
(setq Column$ "")
(while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91)
(setq Column$ (strcat Column$ Char$)
Cell$ (substr Cell$ 2)
);setq
);while
(if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
(list (Alpha2Number Column$) Row#)
'(1 1);default to "A1" if there's a problem
);if
);defun ColumnRow
;-------------------------------------------------------------------------------
; Cell-p - Evaluates if the argument Cell$ is a valid cell ID
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Cell$ = String of the cell ID to evaluate
; Syntax examples: (Cell-p "B12") = t, (Cell-p "BT") = nil
;-------------------------------------------------------------------------------
(defun Cell-p (Cell$)
(and (= (type Cell$) 'STR)
(or (= (strcase Cell$) "A1")
(not (equal (ColumnRow Cell$) '(1 1)))
);or
);and
);defun Cell-p
;-------------------------------------------------------------------------------
(defun rtosr (RealNum~ / DimZin# ShortReal$)
(setq DimZin# (getvar "DIMZIN"))
(setvar "DIMZIN" 8)
(setq ShortReal$ (rtos RealNum~ 2 8))
(setvar "DIMZIN" DimZin#)
ShortReal$
);defun rtosr
;-------------------------------------------------------------------------------
; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
(defun Alpha2Number (Str$ / Num#)
(if (= 0 (setq Num# (strlen Str$)))
0
(+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
(Alpha2Number (substr Str$ 2))
);+
);if
);defun Alpha2Number
;-------------------------------------------------------------------------------
; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"
;-------------------------------------------------------------------------------
(defun Number2Alpha (Num# / Val#)
(if (< Num# 27)
(chr (+ 64 Num#))
(if (= 0 (setq Val# (rem Num# 26)))
(strcat (Number2Alpha (1- (/ Num# 26))) "Z")
(strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
);if
);if
);defun Number2Alpha

Version 1.0 đây !!!
- Hỗ trợ tự động thay đổi bảng mã của bộ gõ Unikey cho phù hợp với đối tượng text hay Mtext trong cad.
- Có tác dụng với các lệnh tạo Text, Mtext và các lệnh chỉnh sửa chúng ED (DDedit)
- Phiên bản này mới chỉ hỗ trợ các text sử dụng True Type Font, chưa hỗ trợ các...

Version 1.0 đây !!!
- Hỗ trợ tự động thay đổi bảng mã của bộ gõ Unikey cho phù hợp với đối tượng text hay Mtext trong cad.
- Có tác dụng với các lệnh tạo Text, Mtext và các lệnh chỉnh sửa chúng ED (DDedit)
- Phiên bản này mới chỉ hỗ trợ các text sử dụng True Type Font, chưa hỗ trợ các font shx.
Vì mới ra lò, khoe các bạn luôn nên mình chưa kịp nghiên cứu thuật toán nhận diện code của font shx, hi vọng các lisper trong diễn đàn cùng chung tay với mình để hoàn thiện ứng dụng này.

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++;;;
;;; A U T O U N I K E Y C O N T R O L R O U T I N E ;;;
;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++;;;
;;; Version 1.0 - 14/12/2012 - from Cadviet.com ;;;
;;; Le Thuy Linh 313 - Tri Tue Viet.jsc ;;;
;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++;;;
;;; Dinh nghia lai lenh ED de lay ename doi tuong text
(defun c:ed (/ textedit)
(and (or (and (setq textedit (ssget "I"))
(setq textedit (ssname textedit 0)))
(setq textedit (car (entsel))))
(command "ddedit" textedit))
(princ))
;;; Kiem tra ban ve da co reactor Auto-Vietkey hay chua, Neu chua co thi tao moi.
(if (not (member "Auto-Unikey" (mapcar 'vlr-data (cdar (vlr-reactors :vlr-sysvar-reactor)))))
(vlr-pers ; Tao lien ket ben vung cho reactor
(vlr-sysvar-reactor "Auto-Unikey" '((:vlr-sysvarchanged . callback-Unikey)))))
;;; Ham callback dieu khien bo go tieng viet (tuong thich voi bo go Unikey)
(defun callback-Unikey (reactor object / code font)
(if (> (getvar "TEXTEDITOR") 0)
(progn
(if textedit
(setq font (vla-get-stylename (vlax-ename->vla-object textedit)))
(setq font (getvar "textstyle")))
(setq code (check-font-code font))
(cond ((= code "TCVN3") (sendkeys "^+{F2}"))
((= code "UNICODE") (sendkeys "^+{F1}"))
((= code "VNI") (sendkeys "^+{F3}"))))))
;;; Ham kiem tra bang ma cua textstyle (su dung true type font)
;;; style: String - ten cua textstlye kiem tra
(defun Check-Font-Code (style / font ts)
(vlax-for ts (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))
(if (= style (vla-get-name ts))
(setq font (vla-get-fontfile ts))))
(cond ((wcmatch (setq font (strcase font)) "ARIAL*,TAHOMA*,TIMES*") "UNICODE")
((wcmatch font "VNI*") "VNI")
((wcmatch font "VN*") "TCVN3")))