;;;                                                                    ;
;;;  PL-RED.LSP   V 5.4 					       ;
;;;  (aus KANAL3D, arbeitet mit mehreren Polylinien (Auswahlsatz))     ;
;;;                                                                    ;
;;;  Copyright 2008                                                    ;
;;;  by Dr. H.-J. Schulz, Dr.-Tolberg-Str.14a, 39218 Schönebeck/E      ;
;;;  eMail scj.schulz@t-online.de                                      ;
;;;  www.black-cad.de                                                  ;
;;;  All Rights Reserved.                                              ;
;;;                                                                    ;
;;;  You are hereby granted permission to use, copy and modify this    ;
;;;  software without charge, provided you do so exclusively for       ;
;;;  your own use.                                                     ;
;;;                                                                    ;
;;;  Incorporation of any part of this software into other software,   ;
;;;  except when such incorporation is exclusively for your own use    ;
;;;  is prohibited.                                                    ;        
;;;                                                                    ;
;;;  Copying, modification and distribution of this software or any    ;
;;;  part thereof in any form except as expressly provided herein is   ;
;;;  prohibited without the consent of the author.                     ;
;;;                                                                    ;
;;;  THE AUTHOR PROVIDES THIS SOFTWARE "AS IS" AND WITH ALL FAULTS.    ;
;;;  THE AUTHOR SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF         ;
;;;  MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. THE AUTHOR DOES  ;
;;;  NOT WARRANT THAT THE OPERATION OF THE SOFTWARE WILL BE            ;
;;;  UNINTERRUPTED OR ERROR FREE.                                      ;
;;;                                                                    ;
;;;                                                                    ;

;;;--------------------------------------------------------------------;
;;;     Function: PL-RED                                               ;
;;;--------------------------------------------------------------------;
;;;  Description: This function will ask the user to select a 	       ;
;;;		  selectionset consisting of 2D- or 3D-Polylines       ;	
;;;               (other objects are filtered).			       ;
;;;		  The number of Verticees will be reduced, considering ;
;;;		  the giver with (tolerance).                          ;
;;;		  The result can be a LW-Polyline or a 3D-Polyline.    ;
;;;--------------------------------------------------------------------;

; Fehlerroutine 
(defun startErrorHandler (varsToSave / )
  (command "_undo" "_Begin")
  (foreach pair varsToSave
    (setq *saveList*
      (cons
        (cons (car pair)(getvar (car pair)))
        *saveList*
      )
    )
    (setvar (car pair)(cdr pair))
  )
  (setq *oldError* *error*)
  (setq *error* myErrorFunction)
)

(defun endErrorHandling( / )
  (*error* nil)
)

(defun myErrorFunction (msg / )
  (if msg (setq msg1 (strcat msg "\nUm alles rückgängig zu machen,
bitte den Befehl ZURÜCK mit Option R verwenden!")))
(alert msg1)
;; ??  (command "_undo" "_end")
  (foreach pair *saveList*
    (setvar (car pair)(cdr pair))
  )
  (setq *saveList* nil)
  (setq *error* *oldError*)
  (setq *oldError* nil)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun run_dcl        (/ fdesc dcl_id)

;;(setq fname (strcat (getvar "dwgprefix") "PLRED.dcl"))
;;(setq FILE_DCL (strcat (getvar "SAVEFILEPATH") "\TOOL_DCL.DCL"); TSchoenwald

  (setq fname (strcat (getvar "dwgprefix") "PLRED.dcl"))

  (setq fdesc (open fname "w"))

  (setq zeilen_dcl "PLRED : dialog {\n 
                label = \"(c) 2011 PL-RED V6.0\"\;
\n: row  {
\n	: boxed_column { label = \"Vorgehensweise : \"\;
\n		: text  { width = 50\;
\n			  key   = br1\; 
\n			}
\n		: text  { width = 10\;
\n			  key   = br2\; 
\n			}
\n		: text  { width = 10\;
\n			  key   = br3\; 
\n			}
\n		: text  { width = 10\;
\n			  key   = br4\; 
\n			}		
\n			}
\n	: boxed_column { label = \"Lizenz erworben von : \"\;
\n		: text  { width = 20\;
\n			  key   = zeile1\; 
\n			}
\n		: text  { width = 10 \;
\n			  key   = zeile2\; 
\n			}
\n		: text  { width = 10\;
\n			  key   = zeile3\; 
\n			}
\n		: text  { width = 10\;
\n			  key   = zeile31\; 
\n			}
\n			}
\n		}
\n: row   {
\n	: boxed_column { label = \"copyright:\" \;
\n		: text {width = 20\;
\n			key   = zeile4\;
\n			}
\n		: text {width = 20\; 
\n			key   = zeile5\;
\n			}
\n		: text {width = 20\;
\n			key   = zeile6\;
\n			}
\n			}
\n	: boxed_column {
\n			label = \"\" \;
\n		: image { width = 7\;
\n			color = dialog_background\;
\n			aspect_ratio = 2.0\;
\n			key = \"BILD\"\;
\n			}
\n		       }
\n	}
\n  : column {
\n     : edit_box {
\n      label = \"Toleranzbreite \"\;
\n      allow_accept = true\;
\n      key         = \"K_B\"\;
\n      edit_width  = 6\;
\n      edit_limit  = 5\;
\n    }
\n  }
\n  spacer\; spacer\;
\n  : boxed_column {
\n	: text {
\n	label = \"Zum Zählen der Polylinienelemente steht der Befehl PL-COUNT zur Verfügung\"\;
\n	}
\n	}
\n   spacer\; spacer\;
\n   ok_cancel\;
\n}"

                )

  (write-line zeilen_dcl fdesc)

  (setq fdesc (close fdesc))
;;  (vl-file-delete fname)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:PL-COUNT ( / satz aa antwort )
; Gibt Anzahl der Elemente in einer Polylinie oder LWPolylinie

;;
 (startErrorHandler
   '(	("osmode" . 0)
	("aunits" . 0)
	("delobj" . 0)
	("cmdecho" . 0)
	("peditaccept" . 0)
      ("cmddia" . 0)
      ("filedia" . 0)
;      ("clayer" . "0")
      ("cecolor" . "0")
      ("ucsicon" . 0)
    )
  )
;;

(setq satz (car (entsel)))
(if (or (= "POLYLINE" (cdr (assoc 0 (entget satz))))
	(= "LWPOLYLINE" (cdr (assoc 0 (entget satz))))
    )
    (progn
	(command "_explode" satz)
	(setq aa (ssget "_P"))
(setq antwort (strcat "Polylinie enthält "(itoa (sslength aa)) " Elemente"))
	(alert antwort)
	(command "_UNDO" "")

    )
    (alert "Das war keine Polylinie!!")
)
;;;

  (foreach pair *saveList*
    (setvar (car pair)(cdr pair))
  )
(command "_undo" "_end")
  (setq *saveList* nil)
  (setq *error* *oldError*)
  (setq *oldError* nil)
;...
;  (endErrorHandling)
(princ)
;;
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
(defun PLRED_DIALOG (/ I1)
 (setq I1 (load_dialog fname))

 (if (null (new_dialog "PLRED" I1))
  (alert "\ncannot load the dialog-box")
 )

 (mode_tile "ok" 2)
 (set_tile "br1" "- funktioniert für 2D- und 3D-Polylinien -")
 (set_tile "br2" "- arbeitet auch mit mehreren Polylinien (Auswahlsatz) -")
 (set_tile "br3" "1. Toleranzbreite eingeben")
 (set_tile "br4" "2. Auswahlsatz mit Polylinien wählen")

(set_tile "zeile1"  "----")
(set_tile "zeile2"  "----")
(set_tile "zeile3"  "----")
(set_tile "zeile31" "----")

(set_tile "zeile4" "black-cad")
(set_tile "zeile5" "H.-J. Schulz")
(set_tile "zeile6" "Schönebeck/E")

;;;;
;(LOGO)
;;;;;;

 (set_tile "K_B" "0.5")         ; Kanalbreite
 
 (setq breit (atof (get_tile "K_B")))


 (action_tile "K_B" "(setq breit (atof $value))")
  
 (action_tile "CANCEL" "(DONE_DIALOG 0)")
 (action_tile "accept" "(done_dialog 1)")
 (setq OK (start_dialog))
 (unload_dialog I1)
 (if (= OK 0)                           ; Abbruchfunktion
  (progn
;   	(command "OSMODE" osmode_old)
;	(command "_AUNITS" aunits_old)
   	(exit)
  )
 )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun 3dabst (p1 p2 p3 / x1 x2 x3 y1 y2 y3 z1 z2 z3 
			tz tn tt xt yt zt)
(if (> (distance p1 p2) eps) 
(progn
;;(print "größer")
; 3DAbstand eines Punktes P3 von einer räumlichen Geraden P1->P2
(setq x1 (car p1) y1 (cadr p1))
	(if (caddr p1) (setq z1 (caddr p1))(setq z1 0))
(setq x2 (car p2) y2 (cadr p2))
	(if (caddr p2) (setq z2 (caddr p2))(setq z2 0))
(setq x3 (car p3) y3 (cadr p3))
	(if (caddr p3) (setq z3 (caddr p3))(setq z3 0))

(setq tz (+ (* (- x3 x1)(- x2 x1))(* (- y3 y1)(- y2 y1))(* (- z3 z1)(- z2 z1))))
(setq tn (+ (* (- x2 x1)(- x2 x1))(* (- y2 y1)(- y2 y1))(* (- z2 z1)(- z2 z1))))
; tn ist nur Null, wenn p1=p2

(setq tt (/ tz tn))

(setq xt (+ x1 (* tt (- x2 x1))))
(setq yt (+ y1 (* tt (- y2 y1))))
(setq zt (+ z1 (* tt (- z2 z1))))

(setq 3DABSTAND (distance p3 (list xt yt zt)))
)
(setq 3DABSTAND 0)
)			; endprogn
)

;--------------------------------------------------------------------------------
(defun LWTPX(sss / lwl elem pt pktx pkty pktz pkt)
;(print"LWLPOLY")(setq xx (getstring))
	(setq plintyp "2D")
	(setq elem sss)
	(setq nv (cdr (assoc 210 elem)))
	(setq tra (cdr (assoc 38 elem)))
	(command "_UCS" "_W")
	(command "_UCS" "_N" "_ZA" "" nv)
	(setq v (list 0 0 tra))
	(command "_UCS" "_O" v)
	(setq pliste nil)
	(foreach pt elem  
				(if (= 10 (car pt)) 
					(progn
					(setq pktx (cadr pt))
					(setq pkty (caddr pt))
					(setq pktz 0)
					(setq pkt (list pktx pkty pktz))
					(setq pkta (trans pkt 1 0))
					(setq pliste (append pliste (list pkta)))
					)
				)

	)
	(command "_UCS" "_W")

)
;----------------------------------------------------------------------------------
(defun PLTPX (sss /  pl1 vertex subent)
;(print "poly")(setq xx (getstring))
	(setq pl1 sss)
	(command "_UCS" "_W")
	(setq pliste nil)                       
			(setq subent (entnext pl1))
			(while (/= (cdr (assoc 0 (entget subent))) "SEQEND")
				(setq vertex (cdr (assoc 10 (entget subent))))
				(setq subent (entnext subent))
				(setq pliste (append (list vertex) pliste))
			)                                       

)

;----------------------------------------------------------------------
(defun KANAL3D (pli / pliste auswahl typ reduzlist i j 
		pstart pende pj exflag x xx radius plintyp)                         
	(setq typ (cdr (assoc 0 (entget pli))))
	(setq offen 0)
	(if (= 1 (cdr (assoc 70 (entget pli))))(setq offen 1))

	(if (= typ  "LWPOLYLINE")       (LWTPX (entget pli)))
	(if (= typ  "POLYLINE")         (PLTPX pli))
	
    (command "_UCS" "_W")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Berechnung;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq reduzlist (list (nth 0 pliste)))
(setq i 0 j 0)
(setq pstart (nth 0 pliste))
(while (< i (length pliste))					;while1
	(progn							;progn1
		(setq i (+ 1 i))
		(setq pende (nth i pliste))
		(setq j 0)
		(setq exflag 0)

		(while (and (<= (+ (- i 1) j) i) (= exflag 0)(< i (- (length pliste) 1)))  ;while2
			(progn					;progn2
; ABSTANDSTEST
				(setq j (+ 1 j))
				(setq pj (nth (+ (- i 1) j) pliste))
				(3dabst pstart pende pj)

				(if (> 3DABSTAND breit)	;if3
					(progn			;progn3
					(setq pnext  (nth i pliste))
					(setq reduzlist (reverse (cons pnext (reverse reduzlist))))		
					(setq pstart (nth i pliste))
;					(setq exflag 1)		
					) 			;endprogn3
				)				;endif3

			)					;endprogn2
		)	       					;endwhile2	


	)							;endprogn1
)								;endwhile1

		(setq pnext  (nth (- i 1) pliste))
		(setq reduzlist (reverse (cons pnext (reverse reduzlist))))
;;;
;(print reduzlist)
;(if (= plintyp "2D")(print plintyp)(print "keine LWPolylinie"))(getstring)
;;;
(if (= (length reduzlist)(length pliste))
	(progn
		(print "Die vorgegebene Kanalbreite
erlaubt keine Reduzierung!")
	)
)	

(if (= plintyp "2D")(command "_pline")(command "_3dpoly"))
(foreach x reduzlist (command x))
(if (= offen 1)(command "_C"))
(command nil)
(princ (strcat "\nDie Ausgangspolylinie hatte " (itoa (length pliste)) " Segmente"))
(princ (strcat "\nDie reduzierte Polylinie hat " (itoa (length reduzlist)) " Segmente"))
)
;;;
;===================== HAUPTPROGRAMM ==================================
; Reduzierung von einer oder mehreren 2D- und 3D-Polylinien mit linearen 
: Segmenten
;; hjs, 31.07.08
; www.black-cad.de
;____________________________
(defun C:PL-RED( / pliste typ breit i j 
		pstart pende pj exflag x xx radius plintyp
		e cmdecho_old osmode_old aunits_old 
		tt dummy 
		satz 
		satz1 
		npl ipl
		fname)                         
;----------------------------
;;
 (startErrorHandler
   '(	("osmode" . 0)
	("aunits" . 0)
	("delobj" . 0)
	("cmdecho" . 0)
	("peditaccept" . 0)
      ("cmddia" . 0)
      ("filedia" . 0)
      ("clayer" . "0")
      ("cecolor" . "0")
      ("ucsicon" . 0)
    )
  )
;;
	(setvar "CMDECHO" 0)
	(setvar "UCSICON" 0)
	(setvar "osmode" 0)

;;
;;Test der MAC-Adresse
;(mactest)
;;

;  Seriennummerntest 
;(SERTEST)
;

; (grtext -1 "PL-RED for 2D- und 3D-polylines")
	(run_dcl)
	(PLRED_DIALOG)
	(vl-file-delete fname)
;;;    					
(alert "Bitte Auswahlsatz anlegen,
Polylinien und LWPolylinien werden automatisch
zur Bearbeitung herausgefiltert.")
 (setq satz (ssget))
 (setq satz1 (ssget "_P" '((-4 . "<OR") (0 . "POLYLINE")(0 . "LWPOLYLINE")
			  (-4 . "OR>")
				))
	)
(setq npl (sslength satz1))

(alert (strcat (itoa npl) " Polylinien und LWPolylinen gefunden!"))
(setq ipl -1)
(while (< ipl (- npl 1))
	(progn
		(setq ipl (+ 1 ipl))
		(print ipl)
		(kanal3d (ssname satz1 ipl))
 	)
)
(princ)

  (foreach pair *saveList*
    (setvar (car pair)(cdr pair))
  )
(command "_undo" "_end")
  (setq *saveList* nil)
  (setq *error* *oldError*)
  (setq *oldError* nil)
;...
;  (endErrorHandling)
(princ)

)
;;
(prompt "\n")
(prompt "Starten durch Eingabe von PL-RED oder PL-COUNT auf der Befehlszeile")