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.

tien2005

Thành viên
  • Số lượng nội dung

    262
  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    8

Cộng đồng

97 (tàm tạm)

About tien2005

  • Cấp bậc
    biết lệnh hatchedit

Phương pháp liên hệ

  • ICQ
    0
  1. 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"))))
×