Quick & dirty.
(defun c:getparallelpt (/ pt ent entss ss dis parlst elst elsts layfilter)
;; CAB 02/05/06
(defun parallel (ln1 ln2 pfuzz / ang1 ang2)
(setq ang1 (angle (cdr (assoc 10 ln1)) (cdr (assoc 11 ln1))))
(setq ang2 (angle (cdr (assoc 10 ln2)) (cdr (assoc 11 ln2))))
(or
(equal ang1 ang2 pfuzz)
;; Check for lines drawn in opposite directions
(equal (min ang1 ang2) (- (max ang1 ang2) pi) pfuzz)
)
)
(while
(progn
(initget 1)
(setq pt (getpoint "\nSelect a point on the a line to find parallels."))
(setq pt (list (car pt) (cadr pt))) ; 2d point
(cond
((null (setq entss (ssget pt '((0 . "LINE")))))
(prompt "\nMissed line, try again.")
t
)
((> (sslength entss) 1)
(prompt "\nToo many lines at that point, try again.")
t
)
((setq ent (ssname entss 0))
nil
)
)
)
)
;;(initget 7)
;;(setq dis (getdist pt "\nEnter the search distance."))
;; set up for max wall to be 9" thick
(setq dis 9)
(setq elst (entget ent))
(setq layfilter (assoc 8 elst))
(setq ss (ssget "_C" (mapcar '(lambda (x) (+ x dis)) pt)
(mapcar '(lambda (x) (- x dis)) pt)
(list '(0 . "LINE") layfilter))
)
(if (and ss (> (sslength ss) 1))
(progn
(setq elsts
(mapcar 'entget
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
)
(foreach ent (vl-remove elst elsts)
(if (parallel elst ent 0.0001)
(setq parlst (cons (cdr (car ent)) parlst))
)
)
(if parlst
(if (> (length parlst) 1)
(prompt "\n*** To many lines parallel, Bye.")
(progn
(setq p2 (vlax-curve-getClosestPointTo (car parlst) (trans pt 1 0) [color=red]T[/color]))
(command "_point" "_non" pt)
(command "_point" "_non" p2)
p2
)
)
(prompt "\n*** No lines parallel, Bye.")
)
)
(prompt "\n*** No lines matching Layer, Bye.")
)
)
Edit: removed prompt for wall thickness