AutoCAD Tips: Visual LISP ตอน จัดแนวข้อความให้เสมอกัน - Alignment Text

บางครั้งในงานเขียนแบบ เมื่อเราเขียนข้อความเพิ่มเข้าไป ซึ่งอาจมาจาก Text หรือ Mtext เพื่อให้รายละเอียด หลังจากเพิ่มไปจำนวนหนึ่ง เมื่อซูมภาพเต็มพื้นที่จัดพิมพ์ ก็อาจพบปัญหาที่แนวข้อความไม่ได้ตรงกัน ดูแล้วไม่เป็นระเบียบ

หัวข้อนี้มาดูกันถึงรูทีน LISP ที่ใช้จัดแนวให้เสมอกัน

TLL - จัดชิดซ้าย
TRR - จัดชิดขวา
THM - จัดเสมอกันได้กึ่งกลางแนวนอน (เสมอกันที่เส้นแนวตั้งหนึ่งๆ)
TLH - จัดชิดแนวนอน

ตัวอย่างพรอมต์ของคำสั่ง TLL

Command: trr
Select Reference text: คลิกเลือกข้อความ (TEXT/MTEXT) ที่จะใช้เป็นแนวอ้างอิง
Select objects: เลือกข้อความ TEXT/MTEXT ที่จะจัดแนว
Select objects: เลือกจนครบ กด Enter

ตอนเลือกสามารถใช้กรอบ Window หรือ Crossing เลือกครอบหรือตัดผ่านวัตถุอื่นก็ได้ คำสั่งนี้จะกรองเอาเฉพาะรูปวาดแบบ TEXT/MTEXT ให้เอง

ผลก่อนใช้ TLL


ผลหลังใช้ TLL


โค้ดมีดังนี้

;;; Align group of texts or mtexts.
;;; TLL, TRR, TVM and THH (Left, Right, Middle-Vertical and Horizontal).
;;; Developed by S.Chatchawal, schatchawal@gmail.com
(vl-load-com)
;;; Left Align
(defun c:TLL (/ stop eRef oRef s LLref URref
j obj LL UR newpt oldpt *acaddoc*
*error*
)
(defun *error* (msg)
(if (not (member msg (list "Function cancelled")))
(princ (strcat "Text Align Error: " msg))
)
(vla-endundomark *acaddoc*)
(princ)
)
(setq *acaddoc*
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(vla-startundomark *acaddoc*)
(while (not stop)
(setq eRef (entsel "\nSelect Reference text: ")
oRef (vlax-ename->vla-object (car eRef))
)
(if (member (vlax-get oRef 'ObjectName)
(list "AcDbText" "AcDbMtext")
)
(progn
(setq stop T)
(vla-highlight oRef :vlax-true)
)
(princ "\nNot Text object, TRY AGAIN!!!")
)
)
(if (setq s (ssget (list (cons 0 "TEXT,MTEXT"))))
(progn
(vlax-invoke-method oRef 'getboundingbox 'minpt 'maxpt)
(setq LLref (vlax-safearray->list minpt)
URref (vlax-safearray->list maxpt)
j -1
)
(repeat (sslength s)
(setq obj (vlax-ename->vla-object (ssname s (setq j (1+ j)))))
(vlax-invoke-method obj 'getboundingbox 'minpt 'maxpt)
(setq LL (vlax-safearray->list minpt)
UR (vlax-safearray->list maxpt)
)
(setq newpt (cons (car LLref) (cdr LL))
oldpt LL
)
(vla-move obj (vlax-3d-point oldpt) (vlax-3d-point newpt))
)
(vla-highlight oRef :vlax-false)
)
(princ "\nNo TEXT found!!!")
)
(vla-endundomark *acaddoc*)
(princ)
)
;;; Right Align
(defun c:TRR (/ stop eRef oRef s LLref URref
j obj LL UR newpt oldpt *acaddoc*
*error*
)
(defun *error* (msg)
(if (not (member msg (list "Function cancelled")))
(princ (strcat "Text Align Error: " msg))
)
(vla-endundomark *acaddoc*)
(princ)
)
(setq *acaddoc*
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(vla-startundomark *acaddoc*)
(while (not stop)
(setq eRef (entsel "\nSelect Reference text: ")
oRef (vlax-ename->vla-object (car eRef))
)
(if (member (vlax-get oRef 'ObjectName)
(list "AcDbText" "AcDbMtext")
)
(progn
(setq stop T)
(vla-highlight oRef :vlax-true)
)
(princ "\nNot Text object, TRY AGAIN!!!")
)
)
(if (setq s (ssget (list (cons 0 "TEXT,MTEXT"))))
(progn
(vlax-invoke-method oRef 'getboundingbox 'minpt 'maxpt)
(setq LLref (vlax-safearray->list minpt)
URref (vlax-safearray->list maxpt)
j -1
)
(repeat (sslength s)
(setq obj (vlax-ename->vla-object (ssname s (setq j (1+ j)))))
(vlax-invoke-method obj 'getboundingbox 'minpt 'maxpt)
(setq LL (vlax-safearray->list minpt)
UR (vlax-safearray->list maxpt)
)
(setq newpt (cons (car URref) (cdr UR))
oldpt UR
)
(vla-move obj (vlax-3d-point oldpt) (vlax-3d-point newpt))
)
(vla-highlight oRef :vlax-false)
)
(princ "\nNo TEXT found!!!")
)
(vla-endundomark *acaddoc*)
(princ)
)
;;; Horizontal-Middle Align
(defun c:THM (/ stop eRef oRef s LLref URref
j obj LL UR newpt oldpt *acaddoc*
*error*
)
(defun *error* (msg)
(if (not (member msg (list "Function cancelled")))
(princ (strcat "Text Align Error: " msg))
)
(vla-endundomark *acaddoc*)
(princ)
)
(setq *acaddoc*
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(vla-startundomark *acaddoc*)
(while (not stop)
(setq eRef (entsel "\nSelect Reference text: ")
oRef (vlax-ename->vla-object (car eRef))
)
(if (member (vlax-get oRef 'ObjectName)
(list "AcDbText" "AcDbMtext")
)
(progn
(setq stop T)
(vla-highlight oRef :vlax-true)
)
(princ "\nNot Text object, TRY AGAIN!!!")
)
)
(if (setq s (ssget (list (cons 0 "TEXT,MTEXT"))))
(progn
(vlax-invoke-method oRef 'getboundingbox 'minpt 'maxpt)
(setq LLref (vlax-safearray->list minpt)
URref (vlax-safearray->list maxpt)
MMref (mapcar '(lambda (x y) (/ (+ x y) 2.0)) LLref URref)
j -1
)
(repeat (sslength s)
(setq obj (vlax-ename->vla-object (ssname s (setq j (1+ j)))))
(vlax-invoke-method obj 'getboundingbox 'minpt 'maxpt)
(setq LL (vlax-safearray->list minpt)
UR (vlax-safearray->list maxpt)
MM (mapcar '(lambda (x y) (/ (+ x y) 2.0)) LL UR)
)
(setq newpt (cons (car MMref) (cdr MM))
oldpt MM
)
(vla-move obj (vlax-3d-point oldpt) (vlax-3d-point newpt))
)
(vla-highlight oRef :vlax-false)
)
(princ "\nNo TEXT found!!!")
)
(vla-endundomark *acaddoc*)
(princ)
)
;;; Lower corner - Horizontal Align
(defun c:TLH (/ stop eRef oRef s LLref URref
j obj LL UR newpt oldpt *acaddoc*
*error*
)
(defun *error* (msg)
(if (not (member msg (list "Function cancelled")))
(princ (strcat "Text Align Error: " msg))
)
(vla-endundomark *acaddoc*)
(princ)
)
(setq *acaddoc*
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(vla-startundomark *acaddoc*)
(while (not stop)
(setq eRef (entsel "\nSelect Reference text: ")
oRef (vlax-ename->vla-object (car eRef))
)
(if (member (vlax-get oRef 'ObjectName)
(list "AcDbText" "AcDbMtext")
)
(progn
(setq stop T)
(vla-highlight oRef :vlax-true)
)
(princ "\nNot Text object, TRY AGAIN!!!")
)
)
(if (setq s (ssget (list (cons 0 "TEXT,MTEXT"))))
(progn
(vlax-invoke-method oRef 'getboundingbox 'minpt 'maxpt)
(setq LLref (vlax-safearray->list minpt)
URref (vlax-safearray->list maxpt)
j -1
)
(repeat (sslength s)
(setq obj (vlax-ename->vla-object (ssname s (setq j (1+ j)))))
(vlax-invoke-method obj 'getboundingbox 'minpt 'maxpt)
(setq LL (vlax-safearray->list minpt)
UR (vlax-safearray->list maxpt)
)
(setq newpt (cons (car LL) (cdr LLref))
oldpt LL
)
(vla-move obj (vlax-3d-point oldpt) (vlax-3d-point newpt))
)
(vla-highlight oRef :vlax-false)
)
(princ "\nNo TEXT found!!!")
)
(vla-endundomark *acaddoc*)
(princ)
)