Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
ThuyLinh313

[Đã xong] - Tự động bật - tắt chế độ gõ tiếng việt trong CAD

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

bạn có thể chuyển sang cho cad đời thấp dùng dc ko ?

vì ko phải ai cũng có nhu cầu cad đời cao , đại đa số các pm nhúng vào cad đều dùng cad 2007 .với một cơ số người thì cad 2007 đủ để phục vụ nhu cầu của họi và nhẹ load hơn nhiều.

thank!

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 có thể chuyển sang cho cad đời thấp dùng dc ko ?

vì ko phải ai cũng có nhu cầu cad đời cao , đại đa số các pm nhúng vào cad đều dùng cad 2007 .với một cơ số người thì cad 2007 đủ để phục vụ nhu cầu của họi và nhẹ load hơn nhiều.

thank!

Lisp này mình lấy về tự chế lại còn bị lỗi 1 số chổ chưa sữa được (đó là phải nhập lệnh ed) nhưng dùng cũng tạm được. Mình dùng cad2008

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/66851-da-xong-tu-dong-bat-tat-che-do-go-tieng-viet-trong-cad/page-2
 
(vl-load-com)
;;; Dinh nghia lai lenh ED de lay ename doi tuong
(defun c:ed (/ textedit font ent n-textedit n-obj n-ent dk code l-obj obj lst)
(SETQ OLDERR *error*
*error* myerror)
(sendkeys "^+")
(and (or (and (setq textedit (ssget "I"))
           	(sssetfirst textedit)
           	(setq obj (ssname textedit 0)))
      	(setq textedit (entsel) obj (car textedit)))
(while obj
;(setq lst (Start-defun nil))
;(setq textedit (car (entsel)))
(setq ent (cdr (assoc 0 (entget obj))))
(cond ((wcmatch ent "*TEXT"); text
(progn
(setq font (cdr (assoc 7 (entget obj))))
;(setq font (vla-get-stylename (vlax-ename->vla-object textedit)))
(call font)
(command "ddedit" textedit "")
))
((= ent "DIMENSION") ;Dimension
(progn
          	(setq font (vla-get-textstyle (vlax-ename->vla-object obj)))
			;(setq font (vla-get-textstyle (vlax-ename->vla-object textedit)))
          	(call font)
			(command "ddedit" textedit "")
))
((= ent "HATCH") ;Hatch
(progn
          	(initdia)
			(call font)
			(command "hatchedit" textedit)
))
((= ent "INSERT") ;Block
          	(and (eq (type textedit) 'LIST)
               	(setq n-textedit (nentselp (cadr textedit)))
               	(setq n-obj (car n-textedit))
               	(setq n-ent (entget n-obj))
               	(setq n-obj (vlax-ename->vla-object n-obj))
               	(cond ((= (cdr (assoc 0 n-ent)) "ATTRIB") ; Attribute
                      	(setq code (check-font-code (cdr (assoc 7 n-ent))))
                      	(if (eq (vla-get-mtextattribute n-obj) :vlax-false)
                       	(progn
                        	;(setq dk nil dk (sendkeys "^+"))
                        	(cond ((= code "TCVN3") (sendkeys "^+{F2}"))
                              	((= code "UNICODE") (sendkeys "^+{F1}"))
                              	((= code "VNI") (sendkeys "^+{F3}")))))
						(vl-cmdf "eattedit" textedit)
                       	(if dk (sendkeys "^+")))
                     	((wcmatch (cdr (assoc 0 n-ent)) "TEXT,MTEXT") ; Text,Mtext in Block
                      	(if (or extract_clone (and (not extract_clone) (load "trexblk.lsp")))
                       	(progn
                        	(extract_clone n-textedit)
                        	(vla-put-visible n-obj :vlax-false)
                        	(entupd obj)
                        	(progn
							(setq l-obj (entlast) font (cdr (assoc 7 n-ent)))
							(call font)
							(vl-cmdf "DDedit" l-obj "")
							)
                        	(vla-put-textstring n-obj (cdr (assoc 1 (entget l-obj))))
                        	(vla-put-visible n-obj :vlax-true)
                        	(entdel l-obj)
                        	(entupd obj))
                       	(princ "Ban chua cai dat goi Express tool cho CAD\n"))))))
); cond	
;(Done-defun lst)		
(setq textedit (entsel) obj (car textedit))
);while
);and
(back)
(command "HIGHLIGHT" 1 "")
(SETQ *error* OLDERR)
(princ))
;;; Ham call dieu khien bo go tieng viet
(defun call (font / code Crfont)
(if font (setq Crfont font) (setq Crfont (getvar "textstyle")))
   (setq code (check-font-code Crfont))
   (cond ((= code "TCVN3") (sendkeys "^+{F2}"))
((= code "UNICODE") (sendkeys "^+{F1}"))
((= code "VNI") (sendkeys "^+{F3}"))
)
)
;;; Ham tra lai English
(defun back ()
(sendkeys "^+")
)
;;; Ham kiem tra bang ma cua textstyle (su dung true type font)
;;; style: String - ten cua textstlye kiem tra
(defun Check-Font-Code (style / ts font Bold Italic charSet PitchandFamily)
(setq ts (vlax-ename->vla-object (tblobjname "style" style)))
(vla-GetFont ts 'font 'Bold 'Italic 'charSet 'PitchandFamily)
(if (= font "") (setq font (vla-get-fontfile ts)))
(cond ((wcmatch (setq font (strcase font)) "ARIAL*,TAHOMA*,TIMES*,COURIER NEW,CAMBRIA,CONSOLAS") "UNICODE")
    ((wcmatch font ".VN*") "TCVN3")
    ((wcmatch font "VNI*") "VNI")))
;;; Ham senkeys
(defun SendKeys (keys / wscript)
(vlax-invoke-method (setq wscript (vlax-create-object "WScript.Shell")) 'sendkeys keys)
(vlax-release-object wscript))
;;;Ham bay loi
(defun myerror (s)
(if (= s "Function Cancelled") (sendkeys "^+"))
  (setq *error* OLDERR)
  (princ)
)
(defun Start-defun (lst-var)
(defun *error* (msg)
(redraw)
(vl-cmdf "undo" "end")
(vl-cmdf "undo" "")
(princ));end
(vl-cmdf "undo" "begin")
(mapcar '(lambda(x) (list x (getvar x))) lst-var));end
;;;
(defun Done-defun (lst-var / )
(mapcar '(lambda (x) (setvar (car x) (cadr x))) lst-var)
(vl-cmdf "undo" "end")
(princ));end

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 có thể chuyển sang cho cad đời thấp dùng dc ko ?

vì ko phải ai cũng có nhu cầu cad đời cao , đại đa số các pm nhúng vào cad đều dùng cad 2007 .với một cơ số người thì cad 2007 đủ để phục vụ nhu cầu của họi và nhẹ load hơn nhiều.

thank!

Mình rất muốn viết cho cad đời thấp để nhiều bạn có thể sử dụng được. Tuy nhiên vấn đề nằm ở chỗ Cad đời thấp từ 2008 trở xuống không hỗ trợ một số chức năng mà lisp trên sử dụng nên không viết được. Nếu cố viết thì cũng chỉ đáp ứng được một phần chức năng so với bản cho cad 2009 trở lên, những công việc mang tính nửa vời như vậy mình không có hứng thú để làm cho lắm.

Mình sẽ suy nghĩ về đề nghị của bạn, nếu mình tìm được giải pháp mới cho cad đời thấp mình sẽ viết. không hứa chắc chắn nhé :)

 

@huunhantvxdts: cảm ơn bạn đã phát triển tiếp lisp này. Tuy nhiên bạn thử xem có ý tưởng gì khác không để viết cho cad2008- bởi nếu vẫn sử dụng cách của mình và sửa lại thì chắc chắn gặp nhiều hạn chế, code bạn sửa về cơ bản thì cũng giống cách bạn phamngoctuks đã sửa nên không giải quyết được triệt để.

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

Tiện đây mình muốn hỏi: Các bạn có í tưởng hay đề xuất gì để lisp này chạy được với các font shx không? mình sẽ phát triển tiếp.

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

Tiện đây mình muốn hỏi: Các bạn có í tưởng hay đề xuất gì để lisp này chạy được với các font shx không? mình sẽ phát triển tiếp.

Hiện tại việc giải quyết cho cad đời thấp là rất hợp lý , vì hầu như các anh em ít ai dùng vượt qua cad 2007 .( nhẹ , dễ cài đặt , đủ đáp ứng nhu cầu )

ứng dụng này của bác có thể phục vụ hầu hết các anh em Bắc-Trung-Nam . vì mỗi vùng có 1 kiểu gõ khác nhau . Bắc(tcvn) - Nam (vni) - riêng bản thân em lại là unicode ( vì nó phổ thông ).

trong nhiều trường hợp có cả 3 loại hình trên .

VD : các nhà thầu tư vấn gồm có B tổng thể - B chính - B phụ

B tổng thể cấp bản vẽ điển hình cho B chính có bộ VNI - ông B chính quen gõ tcvn lại hiệu chỉnh một số text về tcvn rồi lại chuyển bản vẽ cho B phụ - ông B phụ dùng phần mềm thiết kế độc unicode .

rối hết bản vẽ . từ lúc có ứng dụng của bác thì nó đã khắc phục dc phần lớn nhu cầu đó .

nếu ứng dụng dùng dc cho SHX và font hệ thống là hay nhất . đỉnh cao của linh động .

thank ! em nghĩ ứng dụng này là cần thiết và cấp thiết . mong bác dành chút thời gian nghiên cứu hộ anh em .

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

@huunhantvxdts: cảm ơn bạn đã phát triển tiếp lisp này. Tuy nhiên bạn thử xem có ý tưởng gì khác không để viết cho cad2008- bởi nếu vẫn sử dụng cách của mình và sửa lại thì chắc chắn gặp nhiều hạn chế, code bạn sửa về cơ bản thì cũng giống cách bạn phamngoctuks đã sửa nên không giải quyết được triệt để.

Lisp mình viết ở trên là kết hợp giữa của bạn và của bạn phamngoctuks thì phải (bỡi mày mò khá lâu mới chạy được) hiện tại mình sử dụng thấy cũng khá ổn rồi. chỉ bị mắc 1 lỗi là phải đánh ed chứ không kíp đúp được. không biết có bạn nào sử dụng chưa mà không có ý kiế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

Có thể bạn chưa biết. lisp mình viết còn để sử dụng cho bất kỳ lệnh tạo text mới, cả lệnh gốc của cad (T, MT, DT, Mtext, Text...) hay các lệnh được viết bằng lisp có làm thay đổi biến hệ thống TextEditor. Phamngoctuks khi đọc code của mình đã không nhận ra được điều này, mình nghĩ rằng bạn cũng vậy.

Nếu bạn có sử dụng một trong các bản cad 2009 trở lên, hãy thử tải lisp của mình và sử dụng lệnh T, DT, MT sẽ thấy Unikey cũng được can thiệp giống như lệnh ED.

Lisp của bạn và phamngoctuks khi sửa lại vô tình làm mất chức năng này so với lisp gốc của mình, chỉ còn lại chức năng sửa text (ED). Mình nói giống nhau là vậy.

  • 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

Không. vì làm sao để biết nội dung bạn định tìm thuộc bảng mã nào.

Ví dụ: bạn gõ vào nội dung tìm kiếm là bảng mã Unicode, nhưng bản vẽ của bạn lại sử dụng TCVN3 hoặc cả 2.

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ảm ơn các bạn đã tin tưởng và ủng hộ ứng dung này.

Mình sẽ viết lại ứng dụng này cho cad đời thấp mà cụ thể là sẽ tối ưu cho Cad2007,2008 (nhưng mình có thể khẳng định nó sẽ không thông minh như bản cho cad 2009+, tuy nhiên sẽ tốt hơn các lisp mà 2 bạn HuuNhan va PhamNgocTu đã làm)

Ngoài ra mình đã nghĩ ra 1 phương án cho shx. mình sẽ bổ sung phần này cho cả 2 bản.

Vấn đề còn lại là hiện tại mình chưa có thời gian để code do bận chuyện gia đình. Vì thế không biết chắc khi nào sẽ hoàn thành. 2 tuần nữa mình sẽ bắt tay vào code.

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 ơ, mình muốn thêm bảng mã vietware vao trong lips thì làm như thế nào?Mình dung bảng mã vietware thì gõ tiếng việt không đượ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

Không được bạn ạ, vì unikey chỉ hỗ trợ phím tắt cho 4 bảng mã: Unicode, TCVN3, VNI và VIQR tương ứng với 4 tổ hợp phím Ctrl+Shift+ F1; F2; F3; F4. Nếu bạn dùng bộ gõ nào khác có hỗ trợ phím tắt cho Vietware thì hoàn toàn có thể làm đượ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

Lisp này mình lấy về tự chế lại còn bị lỗi 1 số chổ chưa sữa được (đó là phải nhập lệnh ed) nhưng dùng cũng tạm được. Mình dùng cad2008

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/66851-da-xong-tu-dong-bat-tat-che-do-go-tieng-viet-trong-cad/page-2
 
(vl-load-com)
;;; Dinh nghia lai lenh ED de lay ename doi tuong
(defun c:ed (/ textedit font ent n-textedit n-obj n-ent dk code l-obj obj lst)
(SETQ OLDERR *error*
*error* myerror)
(sendkeys "^+")
(and (or (and (setq textedit (ssget "I"))
           	(sssetfirst textedit)
           	(setq obj (ssname textedit 0)))
      	(setq textedit (entsel) obj (car textedit)))
(while obj
;(setq lst (Start-defun nil))
;(setq textedit (car (entsel)))
(setq ent (cdr (assoc 0 (entget obj))))
(cond ((wcmatch ent "*TEXT"); text
(progn
(setq font (cdr (assoc 7 (entget obj))))
;(setq font (vla-get-stylename (vlax-ename->vla-object textedit)))
(call font)
(command "ddedit" textedit "")
))
((= ent "DIMENSION") ;Dimension
(progn
          	(setq font (vla-get-textstyle (vlax-ename->vla-object obj)))
			;(setq font (vla-get-textstyle (vlax-ename->vla-object textedit)))
          	(call font)
			(command "ddedit" textedit "")
))
((= ent "HATCH") ;Hatch
(progn
          	(initdia)
			(call font)
			(command "hatchedit" textedit)
))
((= ent "INSERT") ;Block
          	(and (eq (type textedit) 'LIST)
               	(setq n-textedit (nentselp (cadr textedit)))
               	(setq n-obj (car n-textedit))
               	(setq n-ent (entget n-obj))
               	(setq n-obj (vlax-ename->vla-object n-obj))
               	(cond ((= (cdr (assoc 0 n-ent)) "ATTRIB") ; Attribute
                      	(setq code (check-font-code (cdr (assoc 7 n-ent))))
                      	(if (eq (vla-get-mtextattribute n-obj) :vlax-false)
                       	(progn
                        	;(setq dk nil dk (sendkeys "^+"))
                        	(cond ((= code "TCVN3") (sendkeys "^+{F2}"))
                              	((= code "UNICODE") (sendkeys "^+{F1}"))
                              	((= code "VNI") (sendkeys "^+{F3}")))))
						(vl-cmdf "eattedit" textedit)
                       	(if dk (sendkeys "^+")))
                     	((wcmatch (cdr (assoc 0 n-ent)) "TEXT,MTEXT") ; Text,Mtext in Block
                      	(if (or extract_clone (and (not extract_clone) (load "trexblk.lsp")))
                       	(progn
                        	(extract_clone n-textedit)
                        	(vla-put-visible n-obj :vlax-false)
                        	(entupd obj)
                        	(progn
							(setq l-obj (entlast) font (cdr (assoc 7 n-ent)))
							(call font)
							(vl-cmdf "DDedit" l-obj "")
							)
                        	(vla-put-textstring n-obj (cdr (assoc 1 (entget l-obj))))
                        	(vla-put-visible n-obj :vlax-true)
                        	(entdel l-obj)
                        	(entupd obj))
                       	(princ "Ban chua cai dat goi Express tool cho CAD\n"))))))
); cond	
;(Done-defun lst)		
(setq textedit (entsel) obj (car textedit))
);while
);and
(back)
(command "HIGHLIGHT" 1 "")
(SETQ *error* OLDERR)
(princ))
;;; Ham call dieu khien bo go tieng viet
(defun call (font / code Crfont)
(if font (setq Crfont font) (setq Crfont (getvar "textstyle")))
   (setq code (check-font-code Crfont))
   (cond ((= code "TCVN3") (sendkeys "^+{F2}"))
((= code "UNICODE") (sendkeys "^+{F1}"))
((= code "VNI") (sendkeys "^+{F3}"))
)
)
;;; Ham tra lai English
(defun back ()
(sendkeys "^+")
)
;;; Ham kiem tra bang ma cua textstyle (su dung true type font)
;;; style: String - ten cua textstlye kiem tra
(defun Check-Font-Code (style / ts font Bold Italic charSet PitchandFamily)
(setq ts (vlax-ename->vla-object (tblobjname "style" style)))
(vla-GetFont ts 'font 'Bold 'Italic 'charSet 'PitchandFamily)
(if (= font "") (setq font (vla-get-fontfile ts)))
(cond ((wcmatch (setq font (strcase font)) "ARIAL*,TAHOMA*,TIMES*,COURIER NEW,CAMBRIA,CONSOLAS") "UNICODE")
    ((wcmatch font ".VN*") "TCVN3")
    ((wcmatch font "VNI*") "VNI")))
;;; Ham senkeys
(defun SendKeys (keys / wscript)
(vlax-invoke-method (setq wscript (vlax-create-object "WScript.Shell")) 'sendkeys keys)
(vlax-release-object wscript))
;;;Ham bay loi
(defun myerror (s)
(if (= s "Function Cancelled") (sendkeys "^+"))
  (setq *error* OLDERR)
  (princ)
)
(defun Start-defun (lst-var)
(defun *error* (msg)
(redraw)
(vl-cmdf "undo" "end")
(vl-cmdf "undo" "")
(princ));end
(vl-cmdf "undo" "begin")
(mapcar '(lambda(x) (list x (getvar x))) lst-var));end
;;;
(defun Done-defun (lst-var / )
(mapcar '(lambda (x) (setvar (car x) (cadr x))) lst-var)
(vl-cmdf "undo" "end")
(princ));end

Bạn kiểm tra lại xem sau khi load lsp lên,khi chỉnh sửa text xong nó lại ko tự tắt unikey đi nhể!

Thanks!

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

Lisp này mình lấy về tự chế lại còn bị lỗi 1 số chổ chưa sữa được (đó là phải nhập lệnh ed) nhưng dùng cũng tạm được. Mình dùng cad2008

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/66851-da-xong-tu-dong-bat-tat-che-do-go-tieng-viet-trong-cad/page-2
 
(vl-load-com)
;;; Dinh nghia lai lenh ED de lay ename doi tuong
(defun c:ed (/ textedit font ent n-textedit n-obj n-ent dk code l-obj obj lst)
(SETQ OLDERR *error*
*error* myerror)
(sendkeys "^+")
(and (or (and (setq textedit (ssget "I"))
           	(sssetfirst textedit)
           	(setq obj (ssname textedit 0)))
      	(setq textedit (entsel) obj (car textedit)))
(while obj
;(setq lst (Start-defun nil))
;(setq textedit (car (entsel)))
(setq ent (cdr (assoc 0 (entget obj))))
(cond ((wcmatch ent "*TEXT"); text
(progn
(setq font (cdr (assoc 7 (entget obj))))
;(setq font (vla-get-stylename (vlax-ename->vla-object textedit)))
(call font)
(command "ddedit" textedit "")
))
((= ent "DIMENSION") ;Dimension
(progn
          	(setq font (vla-get-textstyle (vlax-ename->vla-object obj)))
			;(setq font (vla-get-textstyle (vlax-ename->vla-object textedit)))
          	(call font)
			(command "ddedit" textedit "")
))
((= ent "HATCH") ;Hatch
(progn
          	(initdia)
			(call font)
			(command "hatchedit" textedit)
))
((= ent "INSERT") ;Block
          	(and (eq (type textedit) 'LIST)
               	(setq n-textedit (nentselp (cadr textedit)))
               	(setq n-obj (car n-textedit))
               	(setq n-ent (entget n-obj))
               	(setq n-obj (vlax-ename->vla-object n-obj))
               	(cond ((= (cdr (assoc 0 n-ent)) "ATTRIB") ; Attribute
                      	(setq code (check-font-code (cdr (assoc 7 n-ent))))
                      	(if (eq (vla-get-mtextattribute n-obj) :vlax-false)
                       	(progn
                        	;(setq dk nil dk (sendkeys "^+"))
                        	(cond ((= code "TCVN3") (sendkeys "^+{F2}"))
                              	((= code "UNICODE") (sendkeys "^+{F1}"))
                              	((= code "VNI") (sendkeys "^+{F3}")))))
						(vl-cmdf "eattedit" textedit)
                       	(if dk (sendkeys "^+")))
                     	((wcmatch (cdr (assoc 0 n-ent)) "TEXT,MTEXT") ; Text,Mtext in Block
                      	(if (or extract_clone (and (not extract_clone) (load "trexblk.lsp")))
                       	(progn
                        	(extract_clone n-textedit)
                        	(vla-put-visible n-obj :vlax-false)
                        	(entupd obj)
                        	(progn
							(setq l-obj (entlast) font (cdr (assoc 7 n-ent)))
							(call font)
							(vl-cmdf "DDedit" l-obj "")
							)
                        	(vla-put-textstring n-obj (cdr (assoc 1 (entget l-obj))))
                        	(vla-put-visible n-obj :vlax-true)
                        	(entdel l-obj)
                        	(entupd obj))
                       	(princ "Ban chua cai dat goi Express tool cho CAD\n"))))))
); cond	
;(Done-defun lst)		
(setq textedit (entsel) obj (car textedit))
);while
);and
(back)
(command "HIGHLIGHT" 1 "")
(SETQ *error* OLDERR)
(princ))
;;; Ham call dieu khien bo go tieng viet
(defun call (font / code Crfont)
(if font (setq Crfont font) (setq Crfont (getvar "textstyle")))
   (setq code (check-font-code Crfont))
   (cond ((= code "TCVN3") (sendkeys "^+{F2}"))
((= code "UNICODE") (sendkeys "^+{F1}"))
((= code "VNI") (sendkeys "^+{F3}"))
)
)
;;; Ham tra lai English
(defun back ()
(sendkeys "^+")
)
;;; Ham kiem tra bang ma cua textstyle (su dung true type font)
;;; style: String - ten cua textstlye kiem tra
(defun Check-Font-Code (style / ts font Bold Italic charSet PitchandFamily)
(setq ts (vlax-ename->vla-object (tblobjname "style" style)))
(vla-GetFont ts 'font 'Bold 'Italic 'charSet 'PitchandFamily)
(if (= font "") (setq font (vla-get-fontfile ts)))
(cond ((wcmatch (setq font (strcase font)) "ARIAL*,TAHOMA*,TIMES*,COURIER NEW,CAMBRIA,CONSOLAS") "UNICODE")
    ((wcmatch font ".VN*") "TCVN3")
    ((wcmatch font "VNI*") "VNI")))
;;; Ham senkeys
(defun SendKeys (keys / wscript)
(vlax-invoke-method (setq wscript (vlax-create-object "WScript.Shell")) 'sendkeys keys)
(vlax-release-object wscript))
;;;Ham bay loi
(defun myerror (s)
(if (= s "Function Cancelled") (sendkeys "^+"))
  (setq *error* OLDERR)
  (princ)
)
(defun Start-defun (lst-var)
(defun *error* (msg)
(redraw)
(vl-cmdf "undo" "end")
(vl-cmdf "undo" "")
(princ));end
(vl-cmdf "undo" "begin")
(mapcar '(lambda(x) (list x (getvar x))) lst-var));end
;;;
(defun Done-defun (lst-var / )
(mapcar '(lambda (x) (setvar (car x) (cadr x))) lst-var)
(vl-cmdf "undo" "end")
(princ));end

Bạn kiểm tra lại xem sau khi load lsp lên,khi chỉnh sửa text xong nó lại ko tự tắt unikey đi nhể!

Thanks!

Có ai bị như vậy ko nhể chứ của mình vẫn sử dụng bình thường mà ko bị như vậy. chắc bạn chỉnh text xong ấn ESC phải ko??? phải ấn enter để hết lệnh

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

@thuylinh313: sao minh tai về mà dùng không được nhỉ?? minh đang sử dụng cad 2009 và 2014 chạy trên win 8 x32 khi load lisp lên và để unikey ở chế độ tiêng anh nhưng đanh lệnh ed hay kick đúp đều ko có gì xảy ra??

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

Lisp rất hay và tiện dụng. Hy vọng các bác có thể chỉnh sửa cho chạy tốt đối với các đời CAD thấp hơn ví dụ như CAD 2007. Thanks !

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

Trên cơ sở version 3.0 của ThuyLinh313 mình viết lại hổ trợ cho autocad2007

;;; Tu dong bat/tat go Tieng Viet trong autocad
;;; Ho tro cho autocad 2007, duoc viet  tren co so lisp cua ThuyLinh313 tai
;;; http://www.cadviet.com/forum/topic/66851-da-xong-tu-dong-bat-tat-che-do-go-tieng-viet-trong-cad/page-3


(vl-load-com)
(setq switch 0)
(if (= switch 0)
  (setq switchkey "%{z}"); Alt + Z
  (setq switchkey "^+"); Ctrl + Shift - trung voi phim nong saveas "Ctrl + Shift + s"
  )
(setq lscmd "DDEDIT,MTEDIT,TEXTEDIT,EATTEDIT")
;;;(setq lstyp "TEXT,MTEXT,DIMENSION,INSERT,ATTRIB,ATTDEF")
(setq *acdver* (atof (substr (getvar "ACADVER") 1 4)))
(cond
  ((>= *acdver* 21.0)(setq com1 "_textedit")); 21.0-acad2017
  ((<= *acdver* 19.0)(setq com1 "_ddedit")); 19.0- ACAD2013 lower
  (t(ALERT(strcat"Phien ban AutoCad hien tai la "(substr (getvar "ACADVER") 1 4) "\nChua duoc khai bao")))
  )

(if (= hyp-rctCmds nil)
  ; Add the command reactors and the custom callbacks
  (setq hyp-rctCmds (vlr-command-reactor nil '((:vlr-commandCancelled . hyp-cmdAbort)
					       (:vlr-commandEnded . hyp-cmdAbort)
					       (:vlr-commandCancelled . hyp-cmdAbort)
					       (:vlr-commandWillStart . hyp-cmdStart)
					      )
		    )
  )
)
(foreach x (cdar (vlr-reactors :vlr-mouse-reactor))
(if (= (vlr-data x) "Double-Click") (vlr-remove x)))
(vlr-mouse-reactor   "Double-Click" '((:vlr-beginDoubleClick . callback-DoubleClick)))


;========================================MAIN============================================


(defun c:ed (/ textmod	n-textmod ent n-ent obj n-obj l-obj font code)
  (and (or (and	(setq textmod (ssget "I"))
		(sssetfirst textmod)
		(setq obj (ssname textmod 0))
	   )
	   (setq textmod (entsel)
		 obj	  (car textmod)
	   )
       )
       (while obj
	 (setq ent (cdr (assoc 0 (entget obj))))
	 (cond
	   ((wcmatch ent "TEXT,MTEXT,ATTDEF") ;Text,Mtext,ATTDEF
	    (setq font (cdr (assoc 7 (entget obj))))
	    (vl-cmdf com1 textmod "")
	   )
	   ((= ent "DIMENSION")		;Dimension
	    (setq font (vla-get-textstyle (vlax-ename->vla-object obj)))
	    (vl-cmdf com1 textmod "")
	   )
	   ((= ent "HATCH")		;Hatch
	    (initdia)
	    (vl-cmdf "_hatchedit" textmod)
	   )
	   ((= ent "INSERT")		;Block
	    (and
	      (eq (type textmod) 'LIST)
	      (setq n-textmod (nentselp (cadr textmod)))
	      (setq n-obj (car n-textmod))
	      (setq n-ent (entget n-obj))
	      (setq n-obj (vlax-ename->vla-object n-obj))
	      (cond
		((= (cdr (assoc 0 n-ent)) "ATTRIB") ; Attribute
		 (setq font (cdr (assoc 7 n-ent)))
;;;		 (setq code (check-font-code (cdr (assoc 7 n-ent))))
;;;		 (if (eq (vla-get-mtextattribute n-obj) :vlax-false)	;ho tro tu acad2008
;;;		   (progn
;;;		     (setq dk nil
;;;			   dk (sendkeys switchkey)
;;;		     )
;;;		     (cond ((= code "TCVN3") (sendkeys "^+{F2}"))
;;;			   ((= code "UNICODE") (sendkeys "^+{F1}"))
;;;			   ((= code "VNI") (sendkeys "^+{F3}"))
;;;		     )
;;;		   )
;;;		 )

		 (vl-cmdf "_eattedit" textmod)
;;;		 (if dk
;;;		   (sendkeys switchkey)
;;;		 )
		)
		((wcmatch (cdr (assoc 0 n-ent)) "TEXT,MTEXT")
					; Text,Mtext in Block
		 (if (or extract_clone
			 (and (not extract_clone) (load "trexblk.lsp"))
		     )
		   (progn
		     (extract_clone n-textmod)
		     (vla-put-visible n-obj :vlax-false)
		     (entupd obj)
		     (setq l-obj (entlast)
			   font	 (cdr (assoc 7 n-ent))
		     )
		     (vl-cmdf com1 l-obj "")
		     (vla-put-textstring
		       n-obj
		       (cdr (assoc 1 (entget l-obj)))
		     )
		     (vla-put-visible n-obj :vlax-true)
		     (entdel l-obj)
		     (entupd obj)
		   )
		   (princ "Ban chua cai dat goi Express tool cho CAD\n")
		 )
		)
	      )
	    )
	   )
	 )				;cond
	 (setq textmod	(entsel)
	       obj	(car textmod)
	 )

       )
  )
  (princ)
)


;=============================================SUB================================================================


(defun hyp-cmdAbort (param1 param2 )
  (if (and font (wcmatch (strcase (car param2)) lscmd))
    (progn
      (sendkeys switchkey)
      (setq font nil)
      (setvar "HIGHLIGHT" 1)
      )
  )
)

(defun hyp-cmdStart (param1 param2 / code)
  (if (and
;;;	(setq ent (cadr (ssgetfirst)))
;;;	(= 1 (sslength ent))
;;;	(setq ent (ssname ent 0))
;;;	(wcmatch (strcase (cdr (assoc 0 (entget ent)))) lstyp)
	(wcmatch (strcase (car param2)) lscmd)
	font
	(setq code (check-font-code font))
	(cond ((= code "TCVN3") (sendkeys "^+{F2}"))
	      ((= code "UNICODE") (sendkeys "^+{F1}"))
	      ((= code "VNI") (sendkeys "^+{F3}"))
	)
      )
    (sendkeys switchkey)
  )
)
;;; Ham kiem tra bang ma cua textstyle (su dung true type font)
;;; style: String - ten cua textstlye kiem tra
(defun Check-Font-Code
       (style / ts Bold Italic charSet PitchandFamily)

  (setq ts (vlax-ename->vla-object (tblobjname "style" style)))
  (vla-GetFont
    ts 'font 'Bold 'Italic 'charSet 'PitchandFamily)
  (if (= font "")
    (setq font (vla-get-fontfile ts))
  )
  (cond
    
    ((wcmatch (setq font (strcase font)) ".VN*") "TCVN3")
    ((wcmatch font "VNI*") "VNI")
    ((wcmatch font
       "ARIAL*,TAHOMA*,TIMES*,COURIER NEW,CAMBRIA,CONSOLAS,TCVN 7284,MICROSOFT*"
     )
     "UNICODE"
    )
  )
)

;;; Ham senkeys
(defun SendKeys	(keys / wscript)
  (vlax-invoke-method
    (setq wscript (vlax-create-object "WScript.Shell"))
    'sendkeys
    keys
  )
  (vlax-release-object wscript)
)
;;; Ham callback lay textstyle khi Double Click vao text
(defun callback-DoubleClick (reactor point / sset obj ss objtype)
  (setq	sset (vla-get-selectionsets
	       (vla-get-activedocument (vlax-get-acad-object))
	     )
  )
  (if (vl-catch-all-error-p
	(setq ss (vl-catch-all-apply 'vla-item (list sset "Tien2005")))
      )
    (setq ss (vla-add sset "Tien2005"))
    (vla-clear ss)
  )
  (vla-selectatpoint
    ss
    (vlax-3d-point (trans (car point) 0 1))
  )
  (if (> (vlax-get ss 'Count) 0)
    (progn
      (setq obj	    (vla-item ss 0)
	    objtype (vlax-get obj 'ObjectName)
      )
      (if (wcmatch objtype "AcDbText,AcDbMText,AcDbAttributeDefinition")
	(progn
	  (setq font (vla-get-stylename obj))
	  (sssetfirst nil (ssadd (vlax-vla-object->ename obj)))
	)
	(if (not (eq objtype "AcDbBlockReference"))
	  (sssetfirst nil (ssadd (vlax-vla-object->ename obj)))
	)
      )
    )
  )
  (vla-delete ss)
)








;(setq obj (vlax-ename->vla-object (car(entsel"\nchon text"))))

 

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
15 giờ trước, tien2005 cho biết:

Trên cơ sở version 3.0 của ThuyLinh313 mình viết lại hổ trợ cho autocad2007


;;; Tu dong bat/tat go Tieng Viet trong autocad
;;; Ho tro cho autocad 2007, duoc viet  tren co so lisp cua ThuyLinh313 tai
;;; http://www.cadviet.com/forum/topic/66851-da-xong-tu-dong-bat-tat-che-do-go-tieng-viet-trong-cad/page-3


(vl-load-com)
(setq switch 0)
(if (= switch 0)
  (setq switchkey "%{z}"); Alt + Z
  (setq switchkey "^+"); Ctrl + Shift - trung voi phim nong saveas "Ctrl + Shift + s"
  )
(setq lscmd "DDEDIT,MTEDIT,TEXTEDIT,EATTEDIT")
;;;(setq lstyp "TEXT,MTEXT,DIMENSION,INSERT,ATTRIB,ATTDEF")
(setq *acdver* (atof (substr (getvar "ACADVER") 1 4)))
(cond
  ((>= *acdver* 21.0)(setq com1 "_textedit")); 21.0-acad2017
  ((<= *acdver* 19.0)(setq com1 "_ddedit")); 19.0- ACAD2013 lower
  (t(ALERT(strcat"Phien ban AutoCad hien tai la "(substr (getvar "ACADVER") 1 4) "\nChua duoc khai bao")))
  )

(if (= hyp-rctCmds nil)
  ; Add the command reactors and the custom callbacks
  (setq hyp-rctCmds (vlr-command-reactor nil '((:vlr-commandCancelled . hyp-cmdAbort)
					       (:vlr-commandEnded . hyp-cmdAbort)
					       (:vlr-commandCancelled . hyp-cmdAbort)
					       (:vlr-commandWillStart . hyp-cmdStart)
					      )
		    )
  )
)
(foreach x (cdar (vlr-reactors :vlr-mouse-reactor))
(if (= (vlr-data x) "Double-Click") (vlr-remove x)))
(vlr-mouse-reactor   "Double-Click" '((:vlr-beginDoubleClick . callback-DoubleClick)))


;========================================MAIN============================================


(defun c:ed (/ textmod	n-textmod ent n-ent obj n-obj l-obj font code)
  (and (or (and	(setq textmod (ssget "I"))
		(sssetfirst textmod)
		(setq obj (ssname textmod 0))
	   )
	   (setq textmod (entsel)
		 obj	  (car textmod)
	   )
       )
       (while obj
	 (setq ent (cdr (assoc 0 (entget obj))))
	 (cond
	   ((wcmatch ent "TEXT,MTEXT,ATTDEF") ;Text,Mtext,ATTDEF
	    (setq font (cdr (assoc 7 (entget obj))))
	    (vl-cmdf com1 textmod "")
	   )
	   ((= ent "DIMENSION")		;Dimension
	    (setq font (vla-get-textstyle (vlax-ename->vla-object obj)))
	    (vl-cmdf com1 textmod "")
	   )
	   ((= ent "HATCH")		;Hatch
	    (initdia)
	    (vl-cmdf "_hatchedit" textmod)
	   )
	   ((= ent "INSERT")		;Block
	    (and
	      (eq (type textmod) 'LIST)
	      (setq n-textmod (nentselp (cadr textmod)))
	      (setq n-obj (car n-textmod))
	      (setq n-ent (entget n-obj))
	      (setq n-obj (vlax-ename->vla-object n-obj))
	      (cond
		((= (cdr (assoc 0 n-ent)) "ATTRIB") ; Attribute
		 (setq font (cdr (assoc 7 n-ent)))
;;;		 (setq code (check-font-code (cdr (assoc 7 n-ent))))
;;;		 (if (eq (vla-get-mtextattribute n-obj) :vlax-false)	;ho tro tu acad2008
;;;		   (progn
;;;		     (setq dk nil
;;;			   dk (sendkeys switchkey)
;;;		     )
;;;		     (cond ((= code "TCVN3") (sendkeys "^+{F2}"))
;;;			   ((= code "UNICODE") (sendkeys "^+{F1}"))
;;;			   ((= code "VNI") (sendkeys "^+{F3}"))
;;;		     )
;;;		   )
;;;		 )

		 (vl-cmdf "_eattedit" textmod)
;;;		 (if dk
;;;		   (sendkeys switchkey)
;;;		 )
		)
		((wcmatch (cdr (assoc 0 n-ent)) "TEXT,MTEXT")
					; Text,Mtext in Block
		 (if (or extract_clone
			 (and (not extract_clone) (load "trexblk.lsp"))
		     )
		   (progn
		     (extract_clone n-textmod)
		     (vla-put-visible n-obj :vlax-false)
		     (entupd obj)
		     (setq l-obj (entlast)
			   font	 (cdr (assoc 7 n-ent))
		     )
		     (vl-cmdf com1 l-obj "")
		     (vla-put-textstring
		       n-obj
		       (cdr (assoc 1 (entget l-obj)))
		     )
		     (vla-put-visible n-obj :vlax-true)
		     (entdel l-obj)
		     (entupd obj)
		   )
		   (princ "Ban chua cai dat goi Express tool cho CAD\n")
		 )
		)
	      )
	    )
	   )
	 )				;cond
	 (setq textmod	(entsel)
	       obj	(car textmod)
	 )

       )
  )
  (princ)
)


;=============================================SUB================================================================


(defun hyp-cmdAbort (param1 param2 )
  (if (and font (wcmatch (strcase (car param2)) lscmd))
    (progn
      (sendkeys switchkey)
      (setq font nil)
      (setvar "HIGHLIGHT" 1)
      )
  )
)

(defun hyp-cmdStart (param1 param2 / code)
  (if (and
;;;	(setq ent (cadr (ssgetfirst)))
;;;	(= 1 (sslength ent))
;;;	(setq ent (ssname ent 0))
;;;	(wcmatch (strcase (cdr (assoc 0 (entget ent)))) lstyp)
	(wcmatch (strcase (car param2)) lscmd)
	font
	(setq code (check-font-code font))
	(cond ((= code "TCVN3") (sendkeys "^+{F2}"))
	      ((= code "UNICODE") (sendkeys "^+{F1}"))
	      ((= code "VNI") (sendkeys "^+{F3}"))
	)
      )
    (sendkeys switchkey)
  )
)
;;; Ham kiem tra bang ma cua textstyle (su dung true type font)
;;; style: String - ten cua textstlye kiem tra
(defun Check-Font-Code
       (style / ts Bold Italic charSet PitchandFamily)

  (setq ts (vlax-ename->vla-object (tblobjname "style" style)))
  (vla-GetFont
    ts 'font 'Bold 'Italic 'charSet 'PitchandFamily)
  (if (= font "")
    (setq font (vla-get-fontfile ts))
  )
  (cond
    
    ((wcmatch (setq font (strcase font)) ".VN*") "TCVN3")
    ((wcmatch font "VNI*") "VNI")
    ((wcmatch font
       "ARIAL*,TAHOMA*,TIMES*,COURIER NEW,CAMBRIA,CONSOLAS,TCVN 7284,MICROSOFT*"
     )
     "UNICODE"
    )
  )
)

;;; Ham senkeys
(defun SendKeys	(keys / wscript)
  (vlax-invoke-method
    (setq wscript (vlax-create-object "WScript.Shell"))
    'sendkeys
    keys
  )
  (vlax-release-object wscript)
)
;;; Ham callback lay textstyle khi Double Click vao text
(defun callback-DoubleClick (reactor point / sset obj ss objtype)
  (setq	sset (vla-get-selectionsets
	       (vla-get-activedocument (vlax-get-acad-object))
	     )
  )
  (if (vl-catch-all-error-p
	(setq ss (vl-catch-all-apply 'vla-item (list sset "Tien2005")))
      )
    (setq ss (vla-add sset "Tien2005"))
    (vla-clear ss)
  )
  (vla-selectatpoint
    ss
    (vlax-3d-point (trans (car point) 0 1))
  )
  (if (> (vlax-get ss 'Count) 0)
    (progn
      (setq obj	    (vla-item ss 0)
	    objtype (vlax-get obj 'ObjectName)
      )
      (if (wcmatch objtype "AcDbText,AcDbMText,AcDbAttributeDefinition")
	(progn
	  (setq font (vla-get-stylename obj))
	  (sssetfirst nil (ssadd (vlax-vla-object->ename obj)))
	)
	(if (not (eq objtype "AcDbBlockReference"))
	  (sssetfirst nil (ssadd (vlax-vla-object->ename obj)))
	)
      )
    )
  )
  (vla-delete ss)
)








;(setq obj (vlax-ename->vla-object (car(entsel"\nchon text"))))

 

Bạn kiểm tra lại chạy được lisp nhưng không tự bật gõ tiếng việt lên thấy thừa mấy dâu "))"

  • Like 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

@huunhantvxdts: mình đang để phím nóng chuyển Atl+Z, nếu bạn dùng Ctrl+Shift thì khai báo (setq switch 1), phim nóng Ctrl+Shift bị trùng với phím nóng lệnh saveas là Ctrl+Shift+S. Thừa dấu "))" thì tại cửa sổ visual lisp khi load lisp sẽ báo lỗ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

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

Đăng nhập để thực hiện theo  

×