Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
hoangkimoanh

[Yêu câu] cần hướng dẫn giúp gộp file.dcl vào trong file.lsp

Các bài được khuyến nghị

<Cần giúp> muốn gộp file.dcl vào file.lsp thì cần thêm dấu gì vào?

Gửi vào Hôm nay, 12:15 AM

Các anh ơi, cho em hỏi chút là muốn gộp file.dcl vào nội dung của 1 file.lsp thì cần thêm dấu gì vào để nối được vào file lisp ạ!

vì em muốn dùng đơn giản 1 file hơn là copy 2 file đi mọi nơi!

-------------------------

Doan Van Ha

Gửi vào Hôm nay, 08:11 AM

Gộp file DCL vào LSP thì không khó. Vấn đề là bạn biết viết code lisp để load đoạn DCL đó nữa.

Bạn có thể tham khảo rất nhiều file trên forum về vấn đề này.

Hoặc nếu thích chỉ 1 file thì chuyển LSP+DCL thành VLX.

--------------------------------------

em rất muốn biết cách để tích hợp 2 file (.dcl và .lsp) vào 1 file lisp duy nhất để tiện việc quản lý và tổng hợp các lisp vào cho tiện khi load để dùng. khi copy sang may khác cũng dễ dàng hơn.

mong các anh trên diễn đàn giúp em với. (có cách nào để chỉ cần dòng code để đọc phần copy của file.dcl và Paste vào lisp)

cảm ơn các anh nhiều! (em rất sợ lại bị vào thùng rác)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

Tôi khuyên bạn nên chuyển LSP+DCL thành 1 file duy nhất VLX (nếu muốn chỉ dùng 1 file cho thuận tiện). Khi đó bạn chỉ cần load 1 file VLX duy nhất.

Còn việc ghép DCL vào LSP thì phải biết cách code lisp nữa, mỗi file mỗi kiểu. Bạn không biết viết lisp thì sẽ rất khó, còn người biết thì không lẽ cứ mỗi cặp file DCL và LSP lại viết cho bạn 1 code?

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

em chuyển sang .vlx rồi nhưng khi dùng lisp chia đất của bác SSG thì nó báo lỗi đoạn (Pick 1 diem, ve phia can chia so voi duong chuan: ; error: quit / exit).

hay nhờ các anh và bác SSG giúp em gộp cái .dcl vào trong lisp cho gọn trong bài này được không a? cảm ơn các anh rất nhiềuhttp://www.cadviet.com/upfiles/3/103752_new_folder.rar

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Bản chất file LSP của bạn đã bị lỗi trước. Bạn thử load file LSP sẽ thấy báo lỗi ngay.

em thấy load chạy vẫn mượt và ổn định, em không biết lỗi ở đâu cả! nếu có đoạn nào thiếu do em copy không hết anh thêm giúp em với nhe!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

có lẽ khi em up lên có gặp lỗi gì đó! em up lại

;;;=================================
;;;Chuong trinh chia dien tich pline kin
;;;Copyright by ssg - www.cadviet.com - February 2009
;;;=================================

;;;=================================
;;;DIALOG FUNCTIONS
;;;=================================
(defun begin_dialog(DiaFile DiaName)
(setq i (load_dialog DiaFile))
(if (not (new_dialog DiaName i)) (exit))
(action_tile "cancel" "(done_dialog) (command \"regen\") (exit)")
)
;;;-------------------------------------------------------------
(defun end_dialog()
(start_dialog) (unload_dialog i)
)
;;;-------------------------------------------------------------
(defun set_list(MyTile MyList MyVal / j x)
(start_list MyTile)
(setq j 0)
(while (setq x (nth j MyList))
(add_list x)
(setq j (1+ j))
)
(end_list)
(set_tile MyTile MyVal)
)
;;;-------------------------------------------------------------

;;;=================================
;;;PUBLIC FUNCTIONS
;;;=================================
(defun GetMid (p1 p2)
;;;Midpoint: p1, p2
(polar p1 (angle p1 p2) (/ (distance p1 p2) 2))
)
;;;-------------------------------------------------------------
(defun ints (e1 e2 / ob1 ob2 V L1 L2)
;;;Intersections of e1, e2. Return LIST of points
;;;Thank Mr. Hoanh for this function!
(setq
ob1 (vlax-ename->vla-object e1)
ob2 (vlax-ename->vla-object e2)
)
(setq V (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendOtherEntity)))
(if (/= (vlax-safearray-get-u-bound V 1) -1)
(progn
     	(setq L1 (vlax-safearray->list V) L2 nil)
     	(while L1
(setq L2 (append L2 (list (list (car L1) (cadr L1) (caddr L1)))))
(repeat 3 (setq L1 (cdr L1)))
     	)
)
(setq L2 nil)
)
 L2
)
;;;-------------------------------------------------------------
(defun getVert (e / i L)
;;;Return list of all vertex from pline e
(setq i 0 L nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
;;;-------------------------------------------------------------
(defun sideP (p1 p2 e / p1n p2n)
;;;Check same side of 2 points by line e, return T or nil
(command "ucs" "n" "ob" e)
(setq
p1n (trans p1 0 1)
p2n (trans p2 0 1)
)
(command "ucs" "p")
(>= (* (cadr p1n) (cadr p2n)) 0)
)
;;;-------------------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------------------
(defun LastLoad( / K)
(setq K (strcat
"HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\"
"CurrentVersion\\Explorer\\ComDlg32\\OpenSaveMRU\\*"
))
(vl-registry-read K (substr (vl-registry-read K "MRUList") 1 1))
)
;;;-------------------------------------------------------------
(defun addspath(s) ;;;Add support file search path
(setenv "ACAD" (strcat (getenv "ACAD") ";" s))
)
;;;-------------------------------------------------------------

;;;=================================
;;;PRIVATE FUNCTIONS
;;;=================================
(defun area_DL (p)
;;;Get area. Specify by e0, e1, p
;;;Filtered vertex, same side with p
(setq Lf (ints e0 e1))
(foreach x L0
(if (sideP x p e1) (setq Lf (append Lf (list x))))
)
;;;Convert to curve-param and sort
(setq Lpara nil)
(foreach x Lf
(setq para (vlax-curve-getParamAtPoint e0 x))
(setq Lpara (append Lpara (list para)))
)
(setq Lpara (vl-sort Lpara '<))
;;;Get area
(command ".area")
(foreach x Lpara (command (vlax-curve-getPointAtParam e0 x)))
(command "")
(setq S (getvar "area"))
)
;;;-------------------------------------------------------------
(defun move_slow (e ag dr) ;;;Move e by angle ag, step dr
(if (= song 1)
(command "move" e "" (list 0 0) (polar (list 0 0) ag dr))
(if (> dr 0)
   	(command "rotate" e "" pc "r" pC pM pN)
   	(command "rotate" e "" pc "r" pC pN pM)
)
)
)
;;;-------------------------------------------------------------
(defun RunDL ()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq OK nil)
(while (not OK)
(setq
		Li (ints e0 e1)
		i (- (length Li) 1)
		pM (getMid (car Li) (nth i Li))
		pN (polar pM ag tol)
		St (area_DL pN)
)
(if (<= (* St flag) (* S1 flag))
		(progn (setq flag (* flag -1)) (setq OK T))
		(move_slow e1 ag (* flag tol))
)
)
)
;;;-------------------------------------------------------------
(defun ActTyle()
(setq S1 (* S0 (atof $value)))
(set_tile "dientich" (rtos S1))
)
;;;-------------------------------------------------------------
(defun ActDientich()
(setq k (/ (atof $value) S0))
(set_tile "tyle" (rtos k))
)
;;;-------------------------------------------------------------
(defun theoTL()
(mode_tile "tyle" 0)
(mode_tile "dientich" 1)
)
;;;-------------------------------------------------------------
(defun theoDT()
(mode_tile "tyle" 1)
(mode_tile "dientich" 0)
)
;;;-------------------------------------------------------------
(defun SL_chiadat()
(setq
byDT (atoi (get_tile "theodt"))
byTL (atoi (get_tile "theotl"))
S1 (atof (get_tile "dientich"))
k (atof (get_tile "tyle"))
Acc (atoi (get_tile "chinhxac"))
Song (atoi (get_tile "song"))
Ghi (atoi (get_tile "ghi"))
)
)
;;;-------------------------------------------------------------
(defun Dialog_chiadat()
(begin_dialog "chiadat.dcl" "chiadat")
(set_tile "tong" (strcat "Dien tich tong cong = " (rtos S0)))
(set_tile "theodt" (itoa byDT))
(set_tile "theotl" (itoa byTL))
(mode_tile "dientich" byTL)
(mode_tile "tyle" byDT)
(set_tile "dientich" (rtos S1))
(set_tile "tyle" (rtos k))
(set_list "chinhxac" AccList  (itoa Acc))
(set_tile "song" (itoa song))
(set_tile "quay" (itoa quay))
(set_tile "ghi" (itoa ghi))
(action_tile "theodt" "(theoDT)")
(action_tile "theotl" "(theoTL)")
(action_tile "tyle" "(ActTyle)")
(action_tile "dientich" "(ActDientich)")
(action_tile "accept" "(SL_chiadat) (done_dialog)")
(end_dialog)
)
;;;-------------------------------------------------------------
(defun GhiDT()
(wtxt (rtos S1) (getpoint "\nDiem chuan ghi dien tich chia:"))
(wtxt (rtos (- S0 S1)) (getpoint "\nDiem chuan ghi dien tich con lai:"))
)
;;;-------------------------------------------------------------

;;;=================================
;;;MAIN PROGRAM
;;;=================================
(defun C:DL (/ e0 e1 Li i di p0 k tol S0 p1 ag L0 OK Lf x
 	p Lpara para S oldos S00 flag pM pN St prec)
(vl-load-com)
;;;CHON PLINE VA DUONG CHIA
(setq e0 (car (entsel "\nChon 1 pline kin:")))
(redraw e0 3)
(setq
e1 (car (entsel "\nChon duong chia, cat pline it nhat tai 2 diem:"))
Li (ints e0 e1)
)
(redraw e1 3)
(if (< (length Li) 2) (progn (alert "\nKhong tim thay 2 giao diem!") (progn (command "regen") (exit))))
(setq
i (- (length Li) 1)
di (distance (car Li) (nth i Li))
p0 (getpoint "\nPick 1 diem, ve phia can chia so voi duong chuan:")
)
;;;GOI DIALOG
(setq S0 (vlax-curve-getArea e0))
(if (not S1) (setq S1 (/ S0 2)))
(if (not byDT) (setq byDT 1))
(if (= byDT 1) (setq byTL 0) (setq byTL 1))
(if (not Acc) (setq Acc 4))
(if (not song) (setq song 1))
(if (= song 1) (setq quay 0) (setq quay 1))
(if (not ghi) (setq ghi 0))
(setq
k (/ S1 S0)
AccList (list "0" "0.0" "0.00" "0.000" "0.0000" "0.00000" "0.000000" "0.0000000" "0.00000000")
)
(Dialog_chiadat)
(command "regen")
;;;TINH TOAN
(if (= song 0) (setq pc (getpoint "\nChon diem co dinh:")))
(setq
L0 (getVert e0) ;;;List of all vertex
S00 (area_DL p0)
St S00
p1 (vlax-curve-getClosestPointTo e1 p0)
ag (angle p1 p0)
prec (expt 10.0 (- acc))
oldos (getvar "osmode")
)
(cond
((<= (abs (- S00 S1)) prec) (progn (alert "Duong chia da dung vi tri!") (command "regen") (exit)))
((> S00 S1) (setq flag 1))
((< S00 S1) (setq flag -1))
)
(setq tol (* di 0.01))
;;;RUN DIVIDE LAND
(while (> (abs (- St S1)) prec) (runDL) (setq tol (* 0.1 tol)))
(alert "FINISH!")
;;;GHI DIEN TICH
(if (= ghi 1) (GhiDT))
;;;KET THUC
(setvar "cmdecho" 1)
(setvar "osmode" oldos)
(command "regen")
(princ)
)
;;;=================================
;;;Add support file search path
(if (not (findfile "Chiadat.lsp")) (addspath (vl-filename-directory (LastLoad))))
;;;=================================

EM KHÔNG THÊM ĐƯỢC VÀO THẺ CÓ CODE TIẾP NÊN EM COPY TIẾP FILE.DCL VÀO ĐÂY LUÔN:

chiadat :dialog {label = "Chia dien tich Polyline";

spacer;

:text {key= "tong";alignment= centered;}

spacer;

:boxed_row {label= "Chon 1 trong 2 cach chia";

:column{children_fixed_width = true;

:radio_button {label="Theo dien tich "; key = "theodt"; value = 1;}

:radio_button {label="Theo ty le "; key = "theotl";}

}

:column{

:edit_box {key = "dientich"; width = 20; fixed_width= true;}

:edit_box {key = "tyle"; width = 20; fixed_width= true;}

}

}

spacer; spacer;

:popup_list {label= "Do chinh xac"; key= "chinhxac"; width = 40; fixed_width= true;alignment= right;}

spacer; spacer;

:radio_row {label = "Phuong thuc di chuyen duong chia";

:radio_button {label = "Song song"; key = "song"; value = 1;}

:radio_button {label = "Quay quanh 1 diem"; key = "quay";}

spacer;

}

spacer; spacer;

:toggle {label = "Ghi dien tich sau khi chia"; key= "ghi";}

spacer; spacer;

:text{ label= "CHU Y"; alignment= centered;}

:text{ label= "Bam OK, duong chia se di chuyen. Hay cho mot chut..."; alignment= centered;}

spacer; spacer;

ok_cancel;

spacer; spacer;

:text{ label= "Copyright by ssg - www.cadviet.com - February, 2009"; alignment= centered;}

}

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

cảm ơn anh Ha đã quan tâm! dạ còn cách nào để gộp trực tiếp vào file lisp không anh? thông cảm cho em vì em đòi hỏi nhiều quá

Được chứ bạn, Bạn tham khảo Lisp này :

http://www.cadviet.com/forum/index.php?showtopic=9238

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Được chứ bạn, Bạn tham khảo Lisp này :

http://www.cadviet.c...?showtopic=9238

em thêm như lisp này có đúng không, mà dùng không được anh nhỉ?

(setq dclres (list
"chiadat :dialog {label = "Chia dien tich Polyline";"
"spacer;"
":text {key= "tong";alignment= centered;}"
"spacer;"
":boxed_row {label= "Chon 1 trong 2 cach chia";"
":column{children_fixed_width = true;"
  	" :radio_button {label="Theo dien tich           	"; key = "theodt"; value = 1;}"
  	" :radio_button {label="Theo ty le                  	"; key = "theotl";}"
  " }"
":column{"
  	" :edit_box {key = "dientich"; width = 20; fixed_width= true;}"
  	" :edit_box {key = "tyle"; width = 20; fixed_width= true;}"
  " }"
"}"
"spacer; spacer;"
":popup_list {label= "Do chinh xac"; key= "chinhxac"; width = 40; fixed_width= true;alignment= right;}"
"spacer; spacer;"
":radio_row {label = "Phuong thuc di chuyen duong chia";"
  " :radio_button {label = "Song song"; key = "song"; value = 1;}"
  " :radio_button {label = "Quay quanh 1 diem"; key = "quay";}"
  " spacer;"
"}"
"spacer; spacer;"
":toggle {label = "Ghi dien tich sau khi chia"; key= "ghi";}"
"spacer; spacer;"
":text{ label= "CHU Y"; alignment= centered;}"
":text{ label= "Bam OK, duong chia se di chuyen. Hay cho mot chut..."; alignment= centered;}"
"spacer; spacer;"
"ok_cancel;"
"spacer; spacer;"
":text{ label= "Copyright by ssg - www.cadviet.com - February, 2009"; alignment= centered;}"
"}"
 	)
)
(princ)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

em thêm như lisp này có đúng không, mà dùng không được anh nhỉ?

(setq dclres (list
"chiadat :dialog {label = "Chia dien tich Polyline";"
"spacer;"
":text {key= "tong";alignment= centered;}"
"spacer;"
":boxed_row {label= "Chon 1 trong 2 cach chia";"
":column{children_fixed_width = true;"
  	" :radio_button {label="Theo dien tich       		"; key = "theodt"; value = 1;}"
  	" :radio_button {label="Theo ty le                  	"; key = "theotl";}"
  " }"
":column{"
  	" :edit_box {key = "dientich"; width = 20; fixed_width= true;}"
  	" :edit_box {key = "tyle"; width = 20; fixed_width= true;}"
  " }"
"}"
"spacer; spacer;"
":popup_list {label= "Do chinh xac"; key= "chinhxac"; width = 40; fixed_width= true;alignment= right;}"
"spacer; spacer;"
":radio_row {label = "Phuong thuc di chuyen duong chia";"
  " :radio_button {label = "Song song"; key = "song"; value = 1;}"
  " :radio_button {label = "Quay quanh 1 diem"; key = "quay";}"
  " spacer;"
"}"
"spacer; spacer;"
":toggle {label = "Ghi dien tich sau khi chia"; key= "ghi";}"
"spacer; spacer;"
":text{ label= "CHU Y"; alignment= centered;}"
":text{ label= "Bam OK, duong chia se di chuyen. Hay cho mot chut..."; alignment= centered;}"
"spacer; spacer;"
"ok_cancel;"
"spacer; spacer;"
":text{ label= "Copyright by ssg - www.cadviet.com - February, 2009"; alignment= centered;}"
"}"
 	)
)
(princ)

Không đúng nên dùng không được rồi,

Mình nghĩ bạn nên bắt đầu từ những cái cơ bản bạn ạ, rồi có những cái không hiểu, bạn post bài hỏi thì bạn sẽ dễ tiếp thu hơn và bạn sẽ hiểu đúng và đầy đủ bản chất của vấn đề hơn

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Không đúng nên dùng không được rồi,

Mình nghĩ bạn nên bắt đầu từ những cái cơ bản bạn ạ, rồi có những cái không hiểu, bạn post bài hỏi thì bạn sẽ dễ tiếp thu hơn và bạn sẽ hiểu đúng và đầy đủ bản chất của vấn đề hơn

đúng là em chưa có căn bản nên dù sao không biết phải làm thế nào chó đúng. em mong anh có thể giúp em trực tiếp ở cái trên là cần thêm đoạn nào để hỗ trợ đọc lối cái .dcl trong lisp luôn được không a?!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

đúng là em chưa có căn bản nên dù sao không biết phải làm thế nào chó đúng. em mong anh có thể giúp em trực tiếp ở cái trên là cần thêm đoạn nào để hỗ trợ đọc lối cái .dcl trong lisp luôn được không a?!

 

1. Mình dư sức viết cái này nhưng không có thời gian

2. Đã là căn bản thì bạn nên lựa chọn những ví dụ rất đơn giản để giải quyết. Gặp những vấn đề lớn hơn thì cũng dễ giải quyết hơn vì đã biết vấn đề căn bản

3. Bạn có thể tham khảo lại 1 số Lisp đã viết trên diễn đàn (gộp DCL vào Lisp), đường Link mình đưa là 1 ví dụ

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ketxu    2.653

em có  2 file. 1 là lisp và 1 là dcl. mong ai rành về autoisp ghép 2 file này thành 1 file lisp dùm ạ. thank các anh em trước.http://www.cadviet.com/upfiles/3/122369_nho_ghep_file.rar

 

 

=> Bạn có trách nhiệm với câu hỏi của mình một chút đi

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nguyenbd1    13

XIN chia se anh em 1 ứng dụng nhỏ trong autolisp.. để ro ràng tớ xin được trình bày như sau

dưới đây là hình vẽ đơn giản. để vẽ các lỗ taro m8. ban sẽ phải làm ntn.. ban sẽ phải vẽ ra 1 cái sau đó copy nó ra.. hay chuyên nghiệp hơn là bạn tạo 1 block.. 122369_1_2.jpg

không quá phức tạp. sau đây tớ xin trình bày 1 ứng dụng nhỏ của hộip thoại dcl.. cũng là ứng dung chèn block nhung dây là 1 thư viện block mà bạn có thể chỉnh sửa tuỳ thích122369_2_1.jpg

gio tớ xin làm 1 bài để các bạn thấy rõ 

day là hình như trên bản vẽ, và việc tếp theo là tao 4 lỗ taro nhu hình 1.  4 dinh cua hình cn bên trong là diem cần chèn lỗ ta ro122369_4_1.jpg

gõ lệnh G trên dòng command ( sau khi bạn đã load líp vào) sẽ xuất hiện 1 hộp thoại nhu hình trên. giờ hãy chọn 1 thuỳ chọn mà bạn muốn. ở dây là lỗ ta ro m8

122369_5_1.jpg

làm tương tự ta sẽ dược 4 lỗ

122369_1_2.jpg

để được như hình chiếu dứng tớ xin giới thiệu sau

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.680

Bị lỗi gì thì ít nhất bạn cũng nói sơ sơ qua chứ, sao lại hỏi mông lung như vậy?

Bạn post bài nhiều rồi mà không biết forum bị lỗi là không thể down file *.lsp hay sao? Cho nó vào thẻ code đi.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nguyenbd1    13

Bị lỗi gì thì ít nhất bạn cũng nói sơ sơ qua chứ, sao lại hỏi mông lung như vậy?

Bạn post bài nhiều rồi mà không biết forum bị lỗi là không thể down file *.lsp hay sao? Cho nó vào thẻ code đi.

(DEFUN  C:1(/ fname fn create_dialog)

(defun create_dialog ()

(setq fname (vl-filename-mktemp "cuatui.dcl"))

(setq fn (open fname "w"))

(write-line "

cuatui : dialog {

{label=\"TEU CHUAN LUC GIAC : Ban noi buon cho nhung ke thua vui\ ";

  :row {

 

:column

  {label="                         QC      BUOC              KH1    KH2:";

   :button{label="M2      0.5p                   1.6      4.5 ";}

   :button{label="M3       0.5p                   2.5      6 ";}

   :button{label="M4       0.7p                   3.3      8";}

   :button{label="M5       0.8p                  4.2      9";}

   :button{label="M6       1p                     5.0      11";}

   :button{label="M8       1.25p                6.8      14";}

   :button{label="M10       1.5p                 8.5      17";}

   :button{label="M12       1.75p            10.3      19";}

                        :button{label="M14      2p                  12      22 ";}

   :button{label="M16       2p                   14      24";}

   :button{label="M18       2.5p                   15.5      27";}

   :button{label="M20       2.5p                   17.5      31";}

   :button{label="M22       2.5p                   19.5      34";}

   :button{label="M24       3p                         21      37";}

   :button{label="M30       3.5p                   26.5      46";}

   :button{label="M33       3.5p                  26.5      46";}

                        :button{label="M36      3.5p                    32      46 ";}

         }

:column

  {label="                                QC          BUOC              KH1    KH2:";

   :button{label="1/8(3.18)      G40                  2,5      6 ";}

   :button{label="3/16(4.76)   G24                  3,4      8.5 ";}

   :button{label="1/4(6.35)       G20                4,7      11";}

   :button{label="5/16(7.94)       G18                 6,1      14";}

   :button{label="3/8(9.53)       G16                   7,5      15";}

   :button{label="7/16(11.11)       G14               8.8      19";}

   :button{label="1/2(12.7)      G12                 10      20";}

   :button{label="9/16(14.29)       G12              11.6      20";}

                        :button{label="5/8(15.88)      G11                  13      24 ";}

   :button{label="3/4(19.05)       G10               15.8      31";}

   :button{label="7/8(22.22)       G9                18,6      37";}

   :button{label="1(25.4)       G8                21,3      37";}   

         }}

ok_cancel;    

}

" fn)

(close fn))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(create_dialog)

(setq dcl_id (load_dialog fname))

(if (not (new_dialog "cuatui" dcl_id))

(exit)))

)

 

 

xin lỗi bác hà

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
thanhduan2407    227

Không biết mọi người có tham khảo được gì ở LISP này không? 

;;;TAO TEXTSTYLE
(command "-Style" "Times New Roman"  "Times New Roman" 0 1 0 "" "" "" )
(vl-load-com)
;;;KHI LOAD LISP SE HIEN LEN THONG BAO TEN LENH
(Prompt (strcat "\nL\U+1EC7nh ghi ch\U+00FA Text l\U+00E0: GCT2"))

(defun C:GCT2(  / file tmp dch return );;;;;;;GHI CHU TEXT CACH 2
    (cond
      (
        (not
          (and (setq file (open (setq tmp (vl-filename-mktemp nil nil ".dcl")) "w"))
            (write-line
              (strcat
	"	GHICHU"
	"	: dialog"
	"	{"
	"	label = \"Ch\U+01B0\U+01A1ng tr\U+00ECnh vi\U+1EBFt ghi ch\U+00FA Text\";"
	"	            : boxed_column"
	"	            {"
	"	                        : edit_box"
	"	                        {"
	"	                            label = \"Nh\U+1EADp t\U+00EAn c\U+1EA7n vi\U+1EBFt ghi ch\U+00FA\";key = \"Text_ghichu\"; edit_width = 25; alignment = left; value = \"Nh\U+1EADp n\U+1ED9i dung ghi ch\U+00FA v\U+00E0o \U+0111\U+00E2y\";"
	"	                        }"
	"	                        : edit_box"
	"	                        {"
	"	                            label = \"Nh\U+1EADp chi\U+1EC1u cao ch\U+1EEF:\"; key = \"Height_Text\"; edit_width = 3.0; alignment = left; value = 1;"
	"	                        }"
	"	            }"
	"	            : boxed_column"
	"	            {"
	"	            : row"
	"	                        {"
	"	                         : column"
	"	                         {"
	"	                              : popup_list"
	"	                              {"
	"	                                  label = \"L\U+1EF1a ch\U+1ECDn Layer\" ; key = \"LTSLAY\" ; edit_width  = 25 ; list = \"\" ; alignment = left;"
	"	                              }"
	"	                              : popup_list"
	"	                              {"
	"	                                  label = \"L\U+1EF1a ch\U+1ECDn TextStyle\" ; key = \"LTSTEXTSTYLE\" ; edit_width  = 25 ; list = \"\" ; alignment = left;"
	"	                              }"
	"				      spacer;spacer;"
	"				      :row"
	"				      { "
	"					: text"
	"					{"
	"						label = \"Ch\U+1ECDn Color\"; alignment =left;"
	"					}"
	"					: image_button"
	"					{"
	"						key = \"color\"; alignment = centered; height = 1.5; width = 1.0;	fixed_width = false;   fixed_height = true;"
	"					}"
	"				       }"
	"		                         }"
	"	                        }"
	"	            }"
	"	spacer;"
	"	            ok_cancel;"
	"	spacer;spacer;"
	"	:text"
	"	{"
	"		label= \"Ng\U+01B0\U+1EDDi vi\U+1EBFt: Nguy\U+1EC5n Th\U+00E0nh Du\U+00E2n - \U+0110\U+1ECBa Ch\U+00EDnh K48 - 0972.0168.25\";"
	"		alignment= left;"
	"	}"
	"	}"
              )
              file
            )
            (not (close file)) (< 0 (setq dch (load_dialog tmp))) (new_dialog "GHICHU" dch)
          )
        )
      )
      (t
		(action_tile "Text_ghichu"  "(setq TextGhiChu $value)")
		;;;;;;CHO PHEP NHAP NOI DUNG VAO
		(mode_tile "Text_ghichu" 2)
		;;;GAN BIEN CHO TEXTBOX CAO CHU
		(action_tile "Height_Text"  "(setq #Height $value)")
		;;;;;;CHO PHEP NHAP NOI DUNG VAO
		(mode_tile "Height_Text" 2)
		;;;TAO 1 DANH SACH CHUA CAC LAYER CO TRONG BAN VE
		(start_list "LTSLAY")
		(mapcar 'add_list (setq LstLayer (Getlayer)))
		(end_list)


		(if TextGhiChu
			(set_tile "Text_ghichu" TextGhiChu)
			(set_tile "Text_ghichu" "Nh\U+1EADp n\U+1ED9i dung ghi ch\U+00FA v\U+00E0o \U+0111\U+00E2y")
		)

		;;;;GAN LAYER 
		(if #CurLay
			(set_tile "LTSLAY" #CurLay)
			(set_tile "LTSLAY"  "0")
		)
       		(if #Height
			(set_tile "Height_Text" #Height)
			(set_tile "Height_Text"  "1.0")
		)
		(action_tile "LTSLAY" "(setq #CurLay $value)")
		;;;GAN MAU SAC
		(if (null #Color) (setq #Color 2))
		(fill-rec "color" #Color )
		(action_tile "color" "(if (setq #color (acad_colordlg #color)) (fill-rec \"color\" #color ))")
		 
		 ;;;;TAO 1 DANH SACH CHUA CAC TEXTSTYLE
		(start_list "LTSTEXTSTYLE")
		(mapcar 'add_list (setq LstTextStyle (GetTextStyle)))
		(end_list)
		  
		 ;;;;GAN TEXTSTYLE
		(if #CurStyle
			(set_tile "LTSTEXTSTYLE" #CurStyle)
			(set_tile "LTSTEXTSTYLE" "Standard")
		)

		  
		(action_tile "LTSTEXTSTYLE" "(setq #CurStyle $value)")
		;;;;GAN CAC BIEN CHO NOI DUNG GHI CHU, LAYER, TEXTSTYLE
		(if (not TextGhiChu) (setq TextGhiChu (get_tile "Text_ghichu")))
       		(if (not #Height) (setq #Height (get_tile "Height_Text")))
		(if (not #CurLay) (setq #CurLay (get_tile "LTSLAY")))
		(if (not #CurStyle) (setq #CurStyle (get_tile "LTSTEXTSTYLE")))
		;;;;GAN HANH DONG CHO BUTTON OK
		(action_tile "accept" "(setq userclick T)(done_dialog)")
		;;GAN HANH DONG CHO BUTTON CANCEL
		(action_tile "cancel" "(setq userclick nil)(done_dialog)(exit)")

        
      )
    )
    (start_dialog)
    (unload_dialog dch)
    (if (setq tmp (findfile tmp)) (vl-file-delete tmp))
	(if userclick
		(progn
			(GCT1 TextGhiChu #Height #CurLay #CurStyle #Color)
		 )
	)
  )


(defun Getlayer ( / lyr l)
(setq l nil)
(vlax-for lyr
	(vla-get-layers
		(vla-get-activedocument
			(vlax-get-acad-object)
		)
	)
	(setq l (cons (vla-get-name lyr) l))
)
  l
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;HAM CON - LAY RA CAC TEXTSTYLE CO TRONG BAN VE;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GetTextStyle ( / styl_ l)
(setq l nil)
(vlax-for styl_
	(vla-get-textstyles
		(vla-get-activedocument
			(vlax-get-acad-object)
		)
	)
	(setq l (cons (vla-get-name styl_) l))
)
  l
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;HAM CON GHI CHU TEXT;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GCT1 (TextGhiChu h LayerText TextStyle col / i Olmode Gocxoay);;;;GHI CHU TEXT
(setq Olmode (getvar "OSMODE"))
(setvar "OSMODE" 0)
(while  (setq P1 (Getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n TEXT ghi ch\U+00FA: "))
	(setq P2 (Getpoint  P1 "\nChon huong ghi chu TEXT: "))
	(setq Gocxoay (Angle (trans P1 1 0)
	                     (trans P2 1 0)
	              )
	)
	(entmake (list  (cons 0 "TEXT") (cons 10 P1) (cons 8 (nth (atoi LayerText) LstLayer))
			(cons 40 (atof h)) (cons 50 Gocxoay)
			(cons 7 (nth (atoi TextStyle) LstTextStyle)) (cons 1 TextGhiChu) (cons 62 col) ))
)
(setvar "OSMODE" Olmode)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;TAO MOT PICTURE BOX GAN MAU SAC;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun fill-rec (MyTile col / x y)
(start_image MyTile)
(setq x (dimx_tile MyTile) y (dimy_tile MyTile))
(fill_image 0 0 x y col)
(end_image)
)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×