Lệnh NTEXT

Tạo text mới theo Style hiện hành, tự động điều chỉnh bảng mã của bộ gõ tiếng Việt Unikey.

Hỗ trợ 3 loại bảng mã Unicode/TCVN/VNI

Hỗ trợ Unikey với các phím tắt mặc định!

1 Thêm class NTEXT by AJS_.lsp

Lưu mã sau dưới dạng tệp tin NTEXT_by_AJS_.lsp

Code:

; Tạo text mới, căn giữa, đặt tại vị trí pick chuột
(defun C:NTEXT (/ pt txtstr hgt oldcmd)
	(princ "Chuong trinh tao Text - lisp.vn")
	
	(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)
	)
	
	(if font (setq Crfont font) (setq Crfont (getvar "textstyle")))
	(setq code (check-font-code Crfont))
	
	(princ (strcat "\nBang ma: " code))
	(cond ((= code "TCVN3") (sendkeys "^+{F2}"))
		((= code "UNICODE") (sendkeys "^+{F1}"))
		((= code "VNI") (sendkeys "^+{F3}"))
	)
	
	(setq oldcmd (getvar "CMDECHO"))
	(setvar "CMDECHO" 0)

	(princ "\nTạo text mới - căn giữa tại điểm pick")

	; Nhập nội dung text
	(setq txtstr (getstring T "\nNhập nội dung text: "))

	(if (/= txtstr "")
	(progn
	  ; Nhập chiều cao text (có thể thay bằng giá trị cố định nếu muốn)
	  (if (or (null hgt0) (< hgt0 0.0000001)) (setq hgt0 (getvar "TextSize")))
	  (setq hgt (getreal (strcat "\nChiều cao text <" (rtos hgt0 2 3) ">: ")))
	  (if (null hgt) (setq hgt hgt0))
	  (setq hgt0 hgt)
	  
	  ; Pick vị trí đặt text (chính là điểm căn giữa)
	  (setq pt (getpoint "\nPick vị trí đặt text (Middle Center): "))
	  
	  (if pt
		(progn
		  ; Tạo text mới với justification = Middle Center
		  (entmake
			(list
			  '(0 . "TEXT")
			  '(100 . "AcDbEntity")
			  '(100 . "AcDbText")
			  (cons 10 pt)             ; insertion point
			  (cons 40 hgt)            ; text height
			  (cons 1 txtstr)          ; nội dung text
			  (cons 7 (getvar "textstyle"))      ; text style (có thể đổi)
			  '(71 . 0)                ; text generation flags
			  '(72 . 1)                ; horizontal justification = Center
			  '(73 . 2)                ; vertical justification   = Middle
			  (cons 11 pt)             ; insertion point
			)
		  )
		  (princ "\nĐã tạo text mới xong.")
		)
		(princ "\nĐã hủy lệnh (không pick được điểm).")
	  )
	)
	(princ "\nKhông nhập text → hủy lệnh.")
	)

	(setvar "CMDECHO" oldcmd)
	(princ "\nChuong trinh tao Text - lisp.vn\n")	  
	(princ)
)