Visual LISP ลากเส้นตรงแบ่งเป็นช่วงระหว่างสองเส้น

โค้ดนี้เป็นอีกตัวอย่างของการใช้ Visual LISP สำหรับการแก้ไขปัญหา เพื่อสร้างรูปวาดขึ้นตามเงื่อนไขหนึ่งๆ เพื่อช่วยให้งานลดขั้นตอนลงไป ซึ่งจะนำมาซึ่งการลดข้อผิดพลาดลงไปได้ ถือเป็นหลักการอย่างหนึ่งในการเพิ่มผลผลิต (Productivities)

;;; Draw N lines between 2 Lines (Line or LightweightPolyline).
;;; Developed by S.Chatchawal, schatchawal@gmail.com

(defun c:b2 (/ e1 e2 obj1 obj2 L1st L1en
L2st L2en tmp *model-space* pList qList
d1 d2 j p q
)
(if (not #nb2)
(setq #nb2 50)
)
(vl-load-com)
(setq e1 (select1 (list "AcDbLine" "AcDbPolyline")
"\nSelect first line: "
)
e2 (select1 (list "AcDbLine" "AcDbPolyline")
"\nSelect second line: "
)
obj1 (vlax-ename->vla-object e1)
obj2 (vlax-ename->vla-object e2)
L1st (vlax-curve-getStartPoint obj1)
L1en (vlax-curve-getEndPoint obj1)
L2st (vlax-curve-getStartPoint obj2)
L2en (vlax-curve-getEndPoint obj2)
)

(princ "\nEnter number of segments: <")
(princ #nb2)
(princ "> ")
(setq tmp (getint))
(if tmp
(setq #nb2 tmp)
)
(setq *model-space*
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
d1 (/ (vla-get-Length obj1)
#nb2
)
d2 (/ (vla-get-Length obj2)
#nb2
)
j -1
)
(repeat (1+ #nb2)
(setq j (1+ j)
p (vlax-curve-getPointAtDist obj1 (* j d1))
q (vlax-curve-getPointAtDist obj2 (* j d2))
pList (append pList (list p))
qList (append qList (list q))
)
)
(if (> (distance L1st L2st) (distance L1st L2en))
(setq
qList
(reverse qList)
)
)
(setq j -1)
(repeat (1+ #nb2)
(setq j (1+ j))
(vla-addline
*model-space*
(vlax-3d-point (nth j pList))
(vlax-3d-point (nth j qList))
)
)
(princ)
)

(defun select1 (objNameList msg / stop e obj)
(while (not stop)
(if (setq e (entsel msg))
(progn
(setq obj (vlax-ename->vla-object (setq e (car e))))
(if (member (vla-get-ObjectName obj) objNameList)
(setq stop T)
(progn
(princ "Not ")
(princ objNameList)
(princ "!!! Try again!!!")
)
)
)
(princ "\nNo object found!!!")
)
)
e
)