20/03/2026

Lisp miễn phí tạo Text mới theo Textstyle hiện hành tự đổi bảng mã | NTEXT hỗ trợ Unikey | AutoLISP Reviewer

Ứng dụng được phát triển/Sưu tầm bởi đội ngũ AutoLISP Thật là đơn giản
   

Link tải miễn phí phía cuối bài viết: 👉👉👉

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!


Lưu ý: sử dụng phím chuyển là Ctrl+Shift để lisp hoạt động đúng yêu cầu!



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)
)


Link tải miễn phí:

Link tải (MediaFire)



---------------------------------------------------------------------------------------------
Ứng dụng được phát triển bởi đội ngũ AutoLISP Thật là đơn giản - Tác giả ứng dụng in D2P

    

Mọi thông tin xin liên hệ Fanpage AutoLISP Thật là đơn giản!
Cảm ơn bạn đã theo dõi!

Không có nhận xét nào:

Đăng nhận xét

Hàm COUNTIFS đếm theo nhiều điều kiện trong Excel | COUNTIFS, COUNTIF | AutoLISP Reviewer

Hàm COUNTIFS đếm theo nhiều điều kiện trong Excel Cuối tháng cần biết phòng Kế toán có bao nhiêu người đi làm đủ công, bao nhiêu đơn hàng ...