;;;Create a new Polyline with additional vertices at LINE intersections.
;;;
;;;Polylines should not have ARC segments.  If they do the routine
;;;will will find intersections on their chords.
;;;
;;;	AUTHOR: HENRY C. FRANCIS
;;;		425 N. ASHE ST.
;;;		SOUTHERN PINES, NC 28387
;;;		All rights reserved.
;;;
;;;	Copyright:	1-8-97
;;;	Edited:		1-13-97
;;;
(DEFUN c:plint (/	     pl_ss_len	  cur_la       count
		line_ss	     line_ss_len  pline_head   pline_v
		pline_la     plv_1	  1st_lname    frozen_list
		nxt_lname    next_ent	  plv_2	       test_ename
		test_ent     test_v_0	  test_v_1     pt_of_inters
		seg_list     seg_index	  pline_list   raw_list
		sort_list
	       )
  (WHILE
    (NOT
      (EQ
	(CDR
	  (ASSOC
	    0
	    (ENTGET
	      (SETQ
		ent_sel	(CAR (ENTSEL "\nSelect alignment polyline"))
	      ) ;_ end of SETQ
	    ) ;_ end of entget
	  ) ;_ end of assoc
	) ;_ end of cdr
	"POLYLINE"
      ) ;_ end of eq
    ) ;_ end of not
     (PRINC
       (STRCAT
	 "\n"
	 (CDR (ASSOC 0 (ENTGET ent_sel)))
	 " selected, select a POLYLINE (not LWPOLYLINE) to continue. "
       ) ;_ end of strcat
     ) ;_ end of princ
  ) ;_ end of while
  (WHILE (AND (NOT (EQ (CDR (ASSOC 0 (ENTGET ent_sel))) "SEQEND"))
	      (NOT (EQ (CDR (ASSOC 0 (ENTGET ent_sel))) "POLYLINE"))
	 ) ;_ end of and
    (SETQ ent_sel (ENTNEXT ent_sel))
  ) ;_ end of while
  (SETQ	pline_sel   (IF	(EQ (CDR (ASSOC 0 (ENTGET ent_sel))) "SEQEND")
		      (ASSOC -2 (ENTGET ent_sel))
		      ent_sel
		    ) ;_ end of if
	cur_la	    (GETVAR "clayer")
	count	    0
	line_ss	    (SSGET "X" '((0 . "LINE")))
	line_ss_len (SSLENGTH line_ss)
	entint_lst  (LIST (CONS -4 "<OR"))
  ) ;_ end of SETQ
					;select polyline to process.
  (SETQ	pline_head (ENTGET pline_sel)
	pline_v	   (ENTNEXT pline_sel)
	pline_la   (CDR (ASSOC 8 (ENTGET pline_sel)))
	pline_list (LIST (CDR (ASSOC 10 (ENTGET pline_v))))
	next_ent   (CDR (ASSOC 0 (ENTGET (ENTNEXT pline_v))))
  ) ;_ end of SETQ
					;even if more than one is selected only the first in the selection will be processed.
  (SETQ 1st_lname (TBLNEXT "layer" T))
  (IF (= 1 (BOOLE 1 1 (CDR (ASSOC 70 1st_lname))))
    (SETQ frozen_list (LIST (CDR (ASSOC 2 1st_lname))))
  ) ;_ end of IF
  (WHILE (SETQ nxt_lname (TBLNEXT "layer"))
    (IF	(= 1 (BOOLE 1 1 (CDR (ASSOC 70 nxt_lname))))
      (IF frozen_list
	(SETQ frozen_list
	       (APPEND (LIST (CDR (ASSOC 2 nxt_lname)))
		       frozen_list
	       ) ;_ end of APPEND
	) ;_ end of SETQ
	(SETQ frozen_list (LIST (CDR (ASSOC 2 nxt_lname))))
      ) ;_ end of IF
    ) ;_ end of IF
  ) ;_ end of WHILE
					;compile a list of currently frozen layers so their status can be restored.
  (WHILE (NOT (EQ next_ent "SEQEND")) ;_ end of NOT
    (IF	plv_2
      (SETQ plv_1 plv_2)
      (SETQ plv_1 (CDR (ASSOC 10 (ENTGET pline_v))))
    ) ;_ end of IF
    (SETQ plv_2	   (CDR (ASSOC 10 (ENTGET (ENTNEXT pline_v))))
	  next_ent (CDR (ASSOC 0 (ENTGET (ENTNEXT (ENTNEXT pline_v)))))
    ) ;_ end of SETQ
    (WHILE (< count line_ss_len)
      (SETQ test_ename (SSNAME line_ss count)
	    test_ent   (ENTGET test_ename)
	    test_v_0   (CDR (ASSOC 10 test_ent))
	    test_v_1   (CDR (ASSOC 11 test_ent))
      ) ;_ end of SETQ
      (IF				;	AND 
	(SETQ pt_of_inters (INTERS plv_1 plv_2 test_v_0 test_v_1)) ;_ end of SETQ
	 (PROGN
	   (IF raw_list
	     (SETQ raw_list (APPEND raw_list (LIST pt_of_inters)))
	     (SETQ raw_list (LIST pt_of_inters))
	   )				;compile an unsorted list of intersection points for this segment plv_1,plv_2.
	   (IF entint_lst
	     (SETQ entint_lst
		    (APPEND entint_lst
			    (LIST (CONS -4 "<and")
				  (ASSOC 10 test_ent)
				  (ASSOC 11 test_ent)
				  (CONS -4 "and>")
			    ) ;_ end of LIST
		    ) ;_ end of APPEND
	     ) ;_ end of SETQ
	     (SETQ entint_lst
		    (LIST (CONS -4 "<and")
			  (ASSOC 10 test_ent)
			  (ASSOC 11 test_ent)
			  (CONS -4 "and>")
		    ) ;_ end of LIST
	     ) ;_ end of SETQ
	   ) ;_ end of IF
	 ) ;_ end of PROGN
      ) ;_ end of IF
      (SETQ count (1+ count))
    ) ;_ end of WHILE
    (SETQ count 0)
    (IF	raw_list
      (PROGN
	(SETQ sort_list nil)
	(raw_sort raw_list plv_1)
					;IF there is a raw_list, sort it here.
	(SETQ pline_list
	       (APPEND pline_list sort_list (LIST plv_2))
	      raw_list nil
	)				;ADD sorted segment intersections list and plv_2 to pline_list
      ) ;_ end of PROGN
      (SETQ pline_list (APPEND pline_list (LIST plv_2)))
					;ADD plv_2 to pline_list.
    ) ;_ end of IF
    (SETQ pline_v (ENTNEXT pline_v))
  ) ;_ end of WHILE
  (SETQ entint_lst (APPEND entint_lst (LIST (CONS -4 "OR>"))))
					;now create a new pline from pline_list
  (ENTMAKE (LIST (CONS 0 "POLYLINE")
		 (CONS 8 cur_la)
		 (CONS 66 1)
		 (CONS 70 128)
		 (CONS 10 (LIST 0 0 0))
	   ) ;_ end of list
  ) ;_ end of entmake
  (FOREACH n pline_list
    (IF	n
      (ENTMAKE (LIST (CONS 0 "VERTEX") (CONS 10 n)))
    ) ;_ end of if
  ) ;_ end of FOREACH
  (ENTMAKE (LIST (CONS 0 "SEQEND")))
  (PRINC)
  (SETQ PLSAV PLINE_LIST)
  (PRINC)
) ;_ end of DEFUN
(DEFUN raw_sort	(raw_list plv_1 / sort_len sort_index)
  (SETQ sort_list nil)
  (FOREACH n raw_list
    (IF	sort_list
      (PROGN
	(SETQ sort_len	 (LENGTH sort_list)
	      sort_index (1- sort_len)
	) ;_ end of SETQ
	(WHILE (>= sort_index 0)
	  (IF (> (DISTANCE plv_1 n)
		 (DISTANCE plv_1 (NTH sort_index sort_list)) ;_ end of DISTANCE
	      ) ;_ end of >
	    (IF	(= sort_index (1- sort_len))
	      (SETQ sort_list  (APPEND sort_list (LIST n))
		    sort_index -1
	      ) ;_ end of SETQ
	      (SETQ sort_list
			       (APPEND
				 (REVERSE (MEMBER (NTH sort_index sort_list)
						  (REVERSE sort_list)
					  ) ;_ end of member
				 )	;partial sort_list from nth 0 to sort_index
				 (LIST n)
				 (CDR (MEMBER (NTH sort_index sort_list)
					      sort_list
				      ) ;_ end of member
				 ) ;_ end of CDR
					;partial sort_list from nth (1+ sort_index) to (1- sort_len)
			       ) ;_ end of APPEND
		    sort_index -1
	      ) ;_ end of SETQ
	    ) ;_ end of if
	    (IF	(= sort_index 0)
	      (SETQ sort_list  (APPEND (LIST n) sort_list)
		    sort_index -1
	      ) ;_ end of setq
	      (SETQ sort_index (1- sort_index))
	    ) ;_ end of if
	  ) ;_ end of IF
	) ;_ end of WHILE
      ) ;_ end of PROGN
      (SETQ sort_list (LIST n))
    ) ;_ end of IF
  ) ;_ end of FOREACH
  (PRINC)
) ;_ end of DEFUN

;|«ViLL© FORMAT OPTIONS...» (72 2 20 2 T "end of " 60 9 2 0 0 T nil nil T)
 ***Don't add text below the comment!***|;

 ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 T T nil T)
 ***Don't add text below the comment!***|;