วันเสาร์ที่ 21 กุมภาพันธ์ พ.ศ. 2552

Visual LISP: TIPS เคล็ดลับ ตอน แปลง Polyline เส้นเดี่ยวแบบมีความหนาเป็นแบบเส้นคู่

งานเขียนแบบวิศวกรรมเรื่องของท่อน้ำ ท่อแอร์ งานถนน ฯลฯ บางครั้งอาจเริ่มต้นไปด้วยการเขียนแทนแนวรูปดังกล่าวด้วยเส้น Polyline (Lightweight Polyline) โดยใช้แบบเส้นเดี่ยว และความกว้างของเส้น (width) เพื่อแทนถึงขนาดของท่อหรือความกว้างถนนในส่วนหนึ่งๆ

งานทำนองนี้สามารถนำมาแปลงจากเส้นเดี่ยวที่มีความกว้าง (Non zero width Polyline) ให้กลายเป็นเส้นคู่ที่มีระยะห่างแทนถึงความกว้างในช่วงนั้นๆ ได้

ในการนี้ได้พัฒนาเป็นโปรแกรม LISP เพื่อช่วยให้งานแปลงเช่นนี้ทำได้อย่างสะดวก
มีสองคำสั่งด้วยกันคือ PLAS กับ PLXS สำหรับเส้นความกว้างแบบขั้นบันได (Ladder width) กับแบบความกว้างที่เปลี่ยนช่วงแบบเรียบเสมอกัน (Smooth width) ตามรูปถัดไปนี้


;;; Convert Single Line LWPolyline with Non-zero width To Double Lines.
;;; Developed by S.Chatchawal, schatchawal@gmail.com

;;; One-by-One select object.
;;; PLA command for Ladder width LWpolyline.
;;; PLX command for Smooth width LWpolyline.

;;; Selection Set mode.
;;; PLAS and PLXS command.

(defun Pldata (obj / j datalist Sw Ew B)
(setq j -1)
(repeat (fix (vlax-curve-getEndParam obj))
(vla-getWidth obj (setq j (1+ j)) 'Sw 'Ew)
(setq B (vla-getBulge obj j))
(setq datalist (append datalist (list (list Sw Ew B))))
)
datalist
)
;;; Only 2D point.
(defun 1pq (p q / u d)
(setq u (mapcar '- q p)
d (sqrt (apply '+ (mapcar '* u u)))
)
(mapcar '/ u (list d d d))
)
(defun nv1 (u)
(list (cadr u) (- (car u)) 0.0)
)
(defun nv2 (u)
(list (- (cadr u)) (car u) 0.0)
)
(defun ufromderiv (m / arctan)
(setq arctan (atan m))
(list (cos arctan) (sin arctan) 0.0)
)
(defun Pl2X (obj / j k datalist Sw Ew wmax B s+ s- e1 e2)
(setvar "cmdecho" 0)
(setq j -1
s+ (ssadd)
s- (ssadd)
wmax 0.0
k 0
)
(repeat (fix (vlax-curve-getEndParam obj))
(vla-getWidth obj (setq j (1+ j)) 'Sw 'Ew)
(setq k (1+ k)
B (vla-getBulge obj j)
stpt (vlax-curve-getPointAtparam obj j)
enpt (vlax-curve-getPointAtparam obj (1+ j))
midpt (vlax-curve-getPointAtparam obj (+ j 0.5))
wmax (apply 'max (list wmax Sw Ew))
)
(segment+ stpt enpt midpt (/ Sw 2.0) (/ Ew 2.0) B)
(setq s+ (ssadd (entlast) s+))
(segment- stpt enpt midpt (/ Sw 2.0) (/ Ew 2.0) B)
(setq s- (ssadd (entlast) s-))
)
(vl-cmdf "pedit" "m" s+ "" "y" "j" "j" "extend" wmax "")
(setq e1 (entlast))
(vl-cmdf "pedit" "m" s- "" "y" "j" "j" "extend" wmax "")
(setq e2 (entlast))
(vl-cmdf "pedit"
"m"
e1
e2
""
"j"
"j"
"both"
(1+ wmax)
"c"
""
)
(vlax-invoke obj 'Delete)
(setvar "cmdecho" 1)
)
(defun Pl2A (obj / j k datalist Sw Ew wmax B s+ s- e1 e2)
(setvar "cmdecho" 0)
(setq j -1
s+ (ssadd)
s- (ssadd)
wmax 0.0
k 0
)
(repeat (fix (vlax-curve-getEndParam obj))
(vla-getWidth obj (setq j (1+ j)) 'Sw 'Ew)
(setq k (1+ k)
B (vla-getBulge obj j)
stpt (vlax-curve-getPointAtparam obj j)
enpt (vlax-curve-getPointAtparam obj (1+ j))
midpt (vlax-curve-getPointAtparam obj (+ j 0.5))
wmax (apply 'max (list wmax Sw Ew))
)
(segment+ stpt enpt midpt (/ Sw 2.0) (/ Ew 2.0) B)
(setq s+ (ssadd (entlast) s+))
(segment- stpt enpt midpt (/ Sw 2.0) (/ Ew 2.0) B)
(setq s- (ssadd (entlast) s-))
)
(vl-cmdf "pedit" "m" s+ "" "y" "j" "j" "add" wmax "")
(setq e1 (entlast))
(vl-cmdf "pedit" "m" s- "" "y" "j" "j" "add" wmax "")
(setq e2 (entlast))
(vl-cmdf "pedit"
"m"
e1
e2
""
"j"
"j"
"both"
(1+ wmax)
"c"
""
)
(vlax-invoke obj 'Delete)
(setvar "cmdecho" 1)
)

(defun 1stderiv (obj pt / U d)
(setq U (vlax-curve-getFirstDeriv
obj
(vlax-curve-getParamAtPoint obj pt)
)
d (sqrt (apply '+ (mapcar '* U U)))
)
(mapcar '/ U (list d d d))
)

(defun segment+
(stpt enpt midpt Sw Ew B
/ *acaddoc* *model-space* n
p q r oldosmode
)
(setq *acaddoc* (vla-get-activedocument
(vlax-get-Acad-Object)
)
*model-space*
(vla-get-modelspace
*acaddoc*
)
oldosmode (getvar "osmode")
)
(cond
((not (zerop B)) ; Arc
(setq Hw (/ (+ Sw Ew) 2.0)
p (mapcar '+
stpt
(mapcar '*
(nv1 (1stderiv obj stpt)
)
(list Sw Sw Sw)
)
)
q (mapcar '+
midpt
(mapcar '*
(nv1 (1stderiv obj midpt)
)
(list Hw Hw Hw)
)
)
r (mapcar '+
enpt
(mapcar '*
(nv1 (1stderiv obj enpt)
)
(list Ew Ew Ew)
)
)
)
(setvar "osmode" 0)
(vl-cmdf "arc"
(trans p 0 1)
(trans q 0 1)
(trans r 0 1)
)
(setvar "osmode" oldosmode)
)
(T ; Straight Line: Bulge = 0.0
(setq n (nv1 (1pq stpt enpt))
p (mapcar '+ stpt (mapcar '* n (list Sw Sw Sw)))
q (mapcar '+ enpt (mapcar '* n (list Ew Ew Ew)))
)
(vla-AddLine
*model-space*
(vlax-3d-point p)
(vlax-3d-point q)
)
)
)
)

(defun segment-
(stpt enpt midpt Sw Ew B
/ *acaddoc* *model-space* n
p q r oldosmode
)
(setq *acaddoc* (vla-get-activedocument
(vlax-get-Acad-Object)
)
*model-space*
(vla-get-modelspace
*acaddoc*
)
oldosmode (getvar "osmode")
)
(cond
((not (zerop B)) ; Arc
(setq Hw (/ (+ Sw Ew) 2.0)
p (mapcar '+
stpt
(mapcar '*
(nv2 (1stderiv obj stpt)
)
(list Sw Sw Sw)
)
)
q (mapcar '+
midpt
(mapcar '*
(nv2 (1stderiv obj midpt)
)
(list Hw Hw Hw)
)
)
r (mapcar '+
enpt
(mapcar '*
(nv2 (1stderiv obj enpt)
)
(list Ew Ew Ew)
)
)
)
(setvar "osmode" 0)
(vl-cmdf "arc"
(trans p 0 1)
(trans q 0 1)
(trans r 0 1)
)
(setvar "osmode" oldosmode)
)
(T ; Straight Line: Bulge = 0.0
(setq n (nv2 (1pq stpt enpt))
p (mapcar '+ stpt (mapcar '* n (list Sw Sw Sw)))
q (mapcar '+ enpt (mapcar '* n (list Ew Ew Ew)))
)
(vla-AddLine
*model-space*
(vlax-3d-point p)
(vlax-3d-point q)
)
)
)
)

(defun c:PLX (/ e *error* *acaddoc*)
(setq *acaddoc* (vla-get-activedocument
(vlax-get-Acad-Object)
)
)
(vla-startundomark *acaddoc*)
(defun *error* (msg)
(if (not (member msg (list "Function cancelled")))
(princ (strcat "PLX Error: " msg))
)
(princ)
)
(while (setq e (entsel))
(pl2X (vlax-ename->vla-object (car e)))
)
(vla-endundomark *acaddoc*)
(princ)
)

(defun c:PLA (/ e *error* *acaddoc*)
(setq *acaddoc* (vla-get-activedocument
(vlax-get-Acad-Object)
)
)
(vla-startundomark *acaddoc*)
(defun *error* (msg)
(if (not (member msg (list "Function cancelled")))
(princ (strcat "PLX Error: " msg))
)
(princ)
)
(while (setq e (entsel))
(pl2A (vlax-ename->vla-object (car e)))
)
(vla-endundomark *acaddoc*)
(princ)
)

(defun c:PLXS (/ s e *error* *acaddoc*)
(setq *acaddoc* (vla-get-activedocument
(vlax-get-Acad-Object)
)
)
(vla-startundomark *acaddoc*)
(defun *error* (msg)
(if (not (member msg (list "Function cancelled")))
(princ (strcat "PLX Error: " msg))
)
(princ)
)
(if (setq s (ssget (list (cons 0 "LWPOLYLINE"))))
(progn
(while (setq e (ssname s 0))
(pl2X (vlax-ename->vla-object e))
(setq s (ssdel e s))
)
)
(princ "\nNo object found!!!")
)
(vla-endundomark *acaddoc*)
(princ)
)

(defun c:PLAS (/ s e *error* *acaddoc*)
(setq *acaddoc* (vla-get-activedocument
(vlax-get-Acad-Object)
)
)
(vla-startundomark *acaddoc*)
(defun *error* (msg)
(if (not (member msg (list "Function cancelled")))
(princ (strcat "PLX Error: " msg))
)
(princ)
)
(if (setq s (ssget (list (cons 0 "LWPOLYLINE"))))
(progn
(while (setq e (ssname s 0))
(pl2A (vlax-ename->vla-object e))
(setq s (ssdel e s))
)
)
(princ "\nNo object found!!!")
)
(vla-endundomark *acaddoc*)
(princ)
)