Visual LISP: Tips ตอนตัดเส้น Line | LWPolyline เปิดช่องว่างที่มีข้อความแทรกอยู่

นอกจากการสร้าง Linetype ที่แทรกตัวอักษรไว้ทุกระยะหนึ่งๆ แล้ว ในบางกรณี อาจจำเป็นต้องใช้วิธีเขียนข้อความกำกับไว้บนแนวเส้นหนึ่งๆ แต่ไม่ได้เป็นข้อความเดิมซ้ำทุกระยะหนึ่งๆ

ซึ่งขั้นตอนของงาน ก็จะเพิ่มขึ้นมาหลังจากเขียนข้อความในแนวเส้นนั้นเสร็จแล้ว ต้องมาใช้คำสั่ง Break เพื่อตัดเส้นเปิดช่องว่างระหว่างข้อความอีกที

เพื่อลดขั้นตอนการทำงานเช่นนี้ จึงได้พัฒนา LISP routine ที่มีพรอมต์เป็น

Command: BT
Percentage of BT factor: <10.0> ใส่ค่าเปอร์เซนต์ของช่องว่างที่จะให้เว้นเพิ่มเติม
Select objects:

เลือกข้อความที่ต้องการ (รับพรอมต์ All ด้วย โดยคำสั่งจะกรองเอาแต่ Text เอง) และเมื่อเลือกครบแล้วให้กด Enter

เพียงเท่านี้คำสั่งนี้ก็จะทำหน้าที่ตัดเส้นเปิดเป็นช่องว่างระหว่างข้อความให้แล้ว

;;; Break Line with Text.
;;; Developed by S.Chatchawal, schatchawal@gmail.com
(vl-load-com)
(defun c:bt (/ s j k e obj p q r
sL eL oldosmode *error* tmp msg L
pr rp 1pr 1rp d
)
(setq oldosmode (getvar "osmode"))
(if (not #bt-factor)
(setq #bt-factor 10.0)
)
(defun *error* (msg)
(if (not
(member msg (list "Function cancelled" "quit / exit abort"))
)
(princ (strcat "BT Error: " msg))
)
(command "_.undo" "_end")
(setvar "cmdecho" 1)
(setvar "osmode" oldosmode)
(princ)
)
(foreach msg (list "\nPercentage of BT factor: <" #bt-factor "> ")
(princ msg)
)
(if (setq tmp (getdist))
(setq #bt-factor tmp)
)
(if (setq s (ssget (list (cons 0 "TEXT"))))
(progn
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(command "_.undo" "_begin")
(setq j -1)
(repeat (sslength s)
(setq e (ssname s (setq j (1+ j)))
obj (vlax-ename->vla-object e)
)
(command "_.justifytext" e "" "mc")
(setq q
(vlax-safearray->list
(vlax-variant-value (vla-get-TextAlignMentPoint obj))
)
p (vlax-safearray->list
(vlax-variant-value (vla-get-InsertionPoint obj))
)
r (mapcar '+ q (mapcar '- q p))
p (trans p 0 1)
r (trans r 0 1)
L (* (/ #bt-factor 200.0) (distance p r))
pr (mapcar '- r p)
rp (mapcar '- p r)
d (sqrt (apply '+ (mapcar '* pr pr)))
1pr (mapcar '/ pr (list d d d))
1rp (mapcar '/ rp (list d d d))
p (mapcar '+ p (mapcar '* 1rp (list L L L)))
r (mapcar '+ r (mapcar '* 1pr (list L L L)))
)
(if (setq sL (ssget "c"
p
r
(list (cons 0 "LINE,LWPOLYLINE"))
)
)
(progn
(setq k -1)
(repeat (sslength sL)
(setq eL (ssname sL (setq k (1+ k)))
)
(command "_.break" eL p r)
)
)
)
)
)
(princ "\nNo object found!!!")
)
(command "_.undo" "_end")
(setvar "osmode" oldosmode)
(setvar "cmdecho" 1)
(princ)
)