CAB,
I'm sorry, "x" was missing in (< leng x). I think it works now.
Here's another way, working in 3D, whatever the plane of lines or UCS.Some little vector and angular calculus routines have to be loaded.
I post them separately rather than include them in the code because I think these routines might be useful.
Edit : I changed the code for more concision and to add the possibility of "extra" :
Something extra would be to limit the search to only those items that intersect a perpendicular point to the original point.
New Edit : The routine have a now 3 arguments : base point, search distance and an option : T or nil.
(findparallel basept dist T) to specify that only lines crossing the perpendicular plane to original line at picked point are searched ("extra")
(findparallel basept dist nil) overwise.
Sub routines :
;;; Returns the single unit vector from p1 to p2
(defun VEC1 (p1 p2)
(if (not (equal p1 p2 1e-009))
(mapcar
'(lambda (x) (/ x (distance p1 p2)))
(mapcar '- p2 p1)
)
)
)
;;; Returns an angle cosinus
(defun ACOS (num)
(cond
((equal num 1 1e-9) 0.0)
((equal num -1 1e-9) pi)
((< -1 num 1)
(atan (sqrt (- 1 (expt num 2))) num)
)
)
)
;;; Returns the 3D angle defined by 3 3D points
(defun ANGLE_3PTS (som p1 p2 / d1 d2 d3)
(setq d1 (distance som p1)
d2 (distance som p2)
d3 (distance p1 p2)
)
(if (and (< 0 d1) (< 0 d2))
(ACOS (/ (+ (* d1 d1) (* d2 d2) (- (* d3 d3)))
(* 2 d1 d2)
)
)
)
)
;;; Returns the coordinates of a point's projection on a plane defined by its normal and origin
(defun PROJ_PT (pt org norm)
(mapcar '-
pt
(mapcar
'(lambda (x)
(* x
(cos (ANGLE_3PTS org (mapcar '+ org norm) pt))
(distance org pt)
)
)
zdir
)
)
)Main function :
(defun findparallel
(basept leng opt / ss elst lay zdir linelst intlst distlst)
(vl-load-com)
(if
(and (setq ss (ssget basept '((0 . "LINE"))))
(setq elst (entget (ssname ss 0)))
(setq basept (trans (osnap basept "_nea") 1 0))
(setq lay (cdr (assoc 8 elst)))
(setq zdir (VEC1 (cdr (assoc 10 elst)) (cdr (assoc 11 elst))))
(setq
ss (ssdel (cdr (assoc -1 elst))
(ssget "_X" (list '(0 . "LINE") (cons 8 lay)))
)
)
(setq linelst
(vl-remove-if-not
'(lambda (l / v)
(setq v (VEC1 (cdr (assoc 10 (entget l)))
(cdr (assoc 11 (entget l)))
)
)
(and
(or
(equal zdir v 1e-12)
(equal zdir (mapcar '- v) 1e-12)
)
(< (distance
basept
(vlax-curve-getClosestPointTo l basept)
)
leng
)
)
)
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
)
(setq
intlst
(vl-remove-if-not
'vl-consp
(mapcar
'(lambda (l)
(if
(equal basept
(setq
proj (PROJ_PT
(if (equal basept
(cdr (assoc 10 (entget l)))
)
(cdr (assoc 11 (entget l)))
(cdr (assoc 10 (entget l)))
)
basept
zdir
)
)
)
basept
(inters (cdr (assoc 10 (entget l)))
(cdr (assoc 11 (entget l)))
basept
proj
opt ; T for "extra", nil overwise
)
)
)
linelst
)
)
)
(setq
distlst
(mapcar
'(lambda (p)
(distance
basept
p
)
)
intlst
)
)
)
(apply 'min distlst)
)
)
(defun c:test (/ pt sd dist)
(setq pt (getpoint "\nPick a point on a line: ")
sd (getdist pt "\nSearch distance: ")
)
(print)
(findparallel pt sd nil) ; or (findparallel pt sd nil)
)
