;; ***************************************************************
;; pline path finder.lsp
;; Charles Alan Butler 07/08/2004
;; Modified routine to find a path from picked start entity
;; to picked end entity.
;;
;; Returns the first path if it exist else nil, not the shortest path
;; Selects & highlites the path also
;; ***************************************************************
;shortcut
(defun c:plp
() (c:plinepath
))
;;; ***************************************************************
;;; Original Routine
;;;
;;; ;; based on Inline.lsp by John Uhden
;;; ;; modified Joe Burke 5/15/03
;;; ;; pick a line, arc or lwpline
;;; ;; creates a selection set of objects which meet end to end
;;; ;; only selects objects on the same layer as picked object
;;; ;; pass selection set to pedit join...
;;;
;;; ***************************************************************
;;===================================
;; -=< Sub Routines >=-
;;===================================
;; Return (ename Startpt Endpt)
(defun @arc
(ent
/ e rp r ba ea p1 p2
) )
) ;end
;; Return (ename Startpt Endpt)
;; Return (ename Startpt Endpt)
;end
;; Add ent-> (ename Startpt Endpt) to list
)
) ;end
;;argument: an ename - returns: Start and End points as a list
(defun getends
(vobj
/ name stpt endpt
) )
name
'("AcDbArc" "AcDbLine" "AcDbEllipse" "AcDbSpline" "AcDbPolyline" "AcDb2dPolyline"
"AcDb3dPolyline")
)
)
) ;cond
) ;and
) ;end
;; get list of (ename startpt endpt) for picked ent
((= (cdr (assoc 0 ent
)) "LWPOLYLINE") (setq ent
(@pline ent
))) )
ent
) ; end defun
;; *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
;; main function
;; *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
(defun c:plinepath
(/ _dxf sslist elist ss ssres i e e2 found ent
ent2 ok start end start2 end2 fuzz layer ssex typlst tmp
n
)
)
)
;; Get the start object
(if ; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ;;at least one arc, line or pline
) ;and
;; ====== then =============
;; ====== else =============
(setq typlst '
("LINE" "ARC" "LWPOLYLINE")) )
(princ "\nMissed pick or wrong object type: ") ) ;while
) ;progn
) ;if ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;; Get the End object added by CAB
(setq typlst '
("LINE" "ARC" "LWPOLYLINE")) )
(princ "\nMissed pick or wrong object type: ") ) ;while
fuzz 1e-8 ; 0.00000001
)
(= layer
(cdr (assoc 8 ent2
))) ; layers match elist '()
ent2 (get:elst ent2) ; CAB
)
(setq ss
; get all objects that matched picked )
(ssdel e ss
) ; remove picked start from selection set ;; make a list of all from ss ((ename startpt endpt) ....)
;; CAB revised from here down
;; find attached items, does not test all branches
(@ckpoint start ent sslist)
(@ckpoint end ent sslist)
)
) ;and
;; Grab all text in drawing
;; Empty selection set to append
;; Counter to add text values to
(foreach x elist
;; create a selection set of the list ;; Text within distance of textheight to path entity
(_dxf 40 txt)
)
)
ss
)
)
;; Add text to path selection set, sum text and remove from TEXT list (prevents getting summed twice)
tmp
)
)
;;; ;; RJP added fence selection for text object
;;; (setq n 0)
;;; (foreach x elist ; create a selection set of the text **must be on screen**
;;; (if (setq ss (ssget "_F" (list (cadr x) (caddr x)) '((0 . "text"))))
;;; (progn (setq n (+ n (atof (cdr (assoc 1 (entget (ssname ss 0)))))))
;;; (ssadd (ssname ss 0) ssres)
;;; )
;;; )
;;; )
)
) ; progn
(prompt "\n*-* Path not found *-*") )
) ;end
;; -------------------------------
;; @ckPoint by CAB
;; check the list for matching points
;; p point to match
;; elst (ename startpt endpt) of pt
;; |List list pf remaining elst
(defun @ckpoint
(p elst |
list / entx ex p1 p2 idx res
) )
(cond ; test point match with fuzz factor ((equal p start2 fuzz
) ; text for target )
((equal p end2 fuzz
) ; text for target )
((equal p p1 fuzz
) ; test for next branch (if found
; we are backing out collecting the path )
)
((equal p p2 fuzz
) ; test for next branch (if found
; we are backing out collecting the path )
)
)
) ; while
t ; return to satisfy AND
) ; defun
;;========================
;; End Of File
;;========================
