
;;;Bosse-engineering                                                                                       
;;;Dipl.-Ing. Jörn Bosse                                                                                   
;;;Am Klei 5                                                                                               
;;;38458 Velpke                                                                                            
;;;Tel. 05364 / 989 677                                                                                    
;;;mobil. 0176 / 282 323 51                                                                                
;;;bosse@bosse-engineering.com                                                                             
;;;                                                                                                        
;;;--------------------------------------------------------------------------------------------------------
;;;Funktion c: PTX - Es werden Texte erzeugt, die sich an die Linienführung einer 2D-Polylinie ausrichten. 
;;;Die Profile dienen zur Überprüfung auf Ausreißerhöhen.						   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:											   
;;;- JB_PTX$DCL$_[x]_po (Positionen der Dialogfenster)						   	   
;;;- JB_PTX_$DCL$_File (temporäre DCL-Datei)								   
;;;                                                                              Jörn Bosse, 18.02.25	   
;;;--------------------------------------------------------------------------------------------------------



;;;aufrufenden Funktionen
(defun c:PTX ( / )
  (JB_PTX)
  )

;;;Intro
(defun JB_PTX:Intro (str / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n----------------------PTX(1.0), 18.02.25---------------------")
  (princ str)
  (princ "\n--------------------------------------------------------------")
  )




;;;Variablenliste
(defun JB_PTX:v_liste ( / )
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (
                             ("JB_1_r1-3" . 1);;;0 = links ausgerichtet, 1 = Zentrisch, 2 = Rechts
                             ("JB_1_t1" . "Textwert");;;Textwert
			     ("JB_1_p1". "Standard");;;Textstil
			     ("JB_1_p1_Style4EntmakeList" nil);;;wenn Textstilname ungleich "Standard", dann wird die EntmakeListe zur wiederherstellung gespeichert
			     ("JB_1_t2" . "0.625");;;Texthöhe
			     ("JB_1_t3" . "0.0");;;Offset Vertikal positiv oder negativ			     
			     ("JB_1_t5" . "0.1");;;Abstandfaktor (wird mit der Texthöhe mültipliziert
			     ("JB_1_to1" . "0");;;0 = in Richtung der Polylinie, 1 = umgekehrt
			     ("JB_1_r4-5" . 0);;;0 = Text auf aktuellen Layer, 1 = Text auf Polylinienlayer
                             )
                          )
                         )
      ))
  )


;;;Pfad für SIC-Datei in Windows-User
(defun JB_PTX:pfad_ini ( / )
  (strcat (JBf_String:Userpfad:WinUser
                           "LispData\\acad\\"     ;;;Hier ändern, wenn anderer Pfad gewünscht, z.B. MeineTools\\Sicherungen\\ => Der LAufwerksbuchstabe c:\\ wird automatisch gegen das Windows-Benutzerverzeichnis 
                           )"PTX_sic.lsp")  ;;;getauscht, z.B. c:\\User\\[WindowsUsername]\\LispData\\acad\\
  )

;;;Hauptfunktion
(defun JB_PTX ( / PFAD_INI V_LISTE)
  (vl-load-com)

  (setq pfad_ini (JB_PTX:pfad_ini))

  ;;;ab AutoCAD 2014, setzen von vertrauenswürdigen Pfaden für Sicherungsdateien
  (if (JBf_AcadSystem:TrustedPaths?)
    (JBf_AcadSystem:TrustedPaths:Add (strcat(car(fnsplitl pfad_ini))"...")))

    (if (not(setq v_liste (if (findfile pfad_ini)
                          (load pfad_ini)nil)))
    (JBf_SIC:sichern
      (setq v_liste (JB_PTX:v_liste))pfad_ini nil))
  
  (vla-startundomark (vla-get-activedocument(vlax-get-acad-object)))
  (JBf_init
    '(("CMDECHO" 0)
      ("DIMZIN" 3)
      ))

  (setq Osmode_Alt (getvar "OSMODE"))
  
  
  (JB_PTX:Intro "\nPolylinien-Texte.")

  
  (if (not
            (or (and JB_PTX_$DCL$_File(findfile JB_PTX_$DCL$_File))
                (setq JB_PTX_$DCL$_File (JB_PTX:dcl:Write))))
        (progn
          (alert "Die DCL-Datei konnte nicht geschrieben werden.")
          (exit)))

  (JB_PTX:Dbox1 v_liste pfad_ini)
      
   
  (princ "\nEnde.")
  (JBf_Reinit)
  (setvar "OSMODE" Osmode_Alt)
  (vla-endundomark (vla-get-activedocument(vlax-get-acad-object))) 
  (princ)
  )

(defun  JB_PTX:v_liste:DboxSettings:get (key v_liste / )
  (cdr(assoc key(cdr (assoc "DboxSettings" v_liste))))
)


(defun JB_PTX:v_liste:DboxSettings:put (key liste v_liste / DboxList) 
  (setq DboxList (cdr (assoc "DboxSettings" v_liste)))
  (setq DBoxList (JBf_list:subst:gc DBoxList liste key))
  (setq v_liste (JBf_list:subst:gc v_liste DBoxList "DboxSettings"))
  v_liste
  )



;;;Aktueller Space für VLA-Kram
(defun JB_PTX:Dbox1:CurrentSpace ( / )
  (if (or(= (strcase (getvar "CTAB")) "MODEL")
	   (/=(getvar "CVPORT")1))
      (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
      (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
      )
  )


;;;DBox11: TextstileLists
(defun JB_PTX:dbox1:TextStyles ( / )
  (vlax-for ITEM
    (vla-get-TextStyles(vla-get-activeDocument (vlax-get-acad-object)))
    (if (/= (vla-get-name ITEM) "")
    (setq TextStyles&dbox1 (append TextStyles&dbox1
                                    (list (cons (vla-get-name ITEM)
                                                (vl-remove-if '(lambda (X)
                                                                 (member (car X)
                                                                         '(-1 5 330)
                                                                 )
                                                               )
                                                               (entget(vlax-vla-object->ename ITEM)))))
				   )
	  ))
    )

  (if (member (strcase(cdr(assoc "JB_1_p1" Settings&dbox1)))
                                         (mapcar 'strcase (mapcar 'car TextStyles&dbox1)))
    (setq p1_sel&dbox1 (- (length TextStyles&dbox1)
                         (length (member (strcase(cdr(assoc "JB_1_p1" Settings&dbox1)))
					 (mapcar 'strcase(mapcar 'car TextStyles&dbox1))))))
    (progn
      (if (cdr(assoc "JB_1_p1_Style4EntmakeList" Settings&dbox1))
	(entmake (cdr(assoc "JB_1_p1_Style4EntmakeList" Settings&dbox1))))
      (if (tblsearch "STYLE" (cdr(assoc "JB_1_p1" Settings&dbox1)))
	(progn
	  (setq TextStyles&dbox1 (vl-sort(append TextStyles&dbox1(list(cons(cdr(assoc "JB_1_p1" Settings&dbox1))(cdr(assoc "JB_1_p1_Style4EntmakeList" Settings&dbox1))))) '(lambda(e1 e2)(<(car e1)(car e2)))))
	  (setq p1_sel&dbox1 (- (length TextStyles&dbox1)
                         (length (member (strcase(cdr(assoc "JB_1_p1" Settings&dbox1)))
					 (mapcar 'strcase(mapcar 'car TextStyles&dbox1))))))
	  )
	(setq p1_sel&dbox1 0)
	)
      )
    )
)

;;;DBox1 gecatcht, damit im Abbruchfall alle unsichtbaren Texte wieder entfernt werden können
(defun JB_PTX:DBox1:Catched ( / )

  (setq Settings&dbox1 (JB_PTX:v_liste:DboxSettings:get "Dbox1" v_liste))
  (JB_PTX:dbox1:TextStyles)

  (while (not (member ok '(1 99)))
    (setq DclId (JBf_Dcl:Load_dialog JB_PTX_$DCL$_File "JB_PTX_1" JB_PTX$DCL$_1_po))
    (JB_PTX:Dbox1:set)
    (JB_PTX:Dbox1:mode)
    (mapcar '(lambda (A) (action_tile A (strcat "(JB_PTX:Dbox1:action \"" A "\")")))
	    '("JB_1_b1" "JB_1_b2" "JB_1_b3" "JB_1_b4" "JB_1_b5" "JB_1_b6" "JB_1_b7" "JB_1_b8"
	      "JB_1_r1" "JB_1_r2" "JB_1_r3" "JB_1_r4" "JB_1_r5"
	      "JB_1_p1"
	      "JB_1_to1"
	      "accept"
	      "cancel"
	      )
	    )
    (setq ok (start_dialog))
    (unload_dialog DclId)

    (cond
      ((= ok 16) ;;;Zoom
       (vl-catch-all-apply 'getpoint (list "\nmit ENTER zurück ins Dialogfenster."))
       )
      ((= ok 17) ;;;3D-Polylinie picken
       (setq vla-poly&Dbox1 nil
	     Startpkt&DBox1 nil)
       (JB_PTX:Dbox1:GetPoly)
       (JB_PTX:Dbox1:action:Reset 'T)
       )
      ((= ok 18) ;;;Punkt picken
       (if(JB_PTX:Dbox1:PickPoint)
	 (JB_PTX:Dbox1:action:Reset 'T)
	 )
	 
       )
      ((= ok 99);;;Abbrechen
       (mapcar 'vla-delete (mapcar 'car vla-TextList&Dbox1))       
       )
      ((= ok 1)
       (mapcar '(lambda(X)
		  (if (=(JBf_list_xdaten_read "JB_PTX" (vlax-vla-object->ename (car X))1070)0)
		    (vla-delete (car X))
		    
		    ))
	       vla-TextList&Dbox1)
       )
	       
      )
    )
  (setq v_liste (JB_PTX:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
  (JBf_SIC:sichern v_liste pfad_ini nil)
  )
 
;;;DBox 1
(defun JB_PTX:Dbox1 (v_liste pfad_ini / DclId ok TextStyles&dbox1 p1_sel&dbox1 vla-poly&Dbox1 Startpkt&DBox1 vla-TextListPoly&Dbox1 vla-TextList&Dbox1)
  (if (vl-catch-all-error-p
	(vl-catch-all-apply 'JB_PTX:DBox1:Catched))
    (vla-delete (mapcar 'car vla-TextList&Dbox1))
    )

  )


;;;Action (Variable global in Aufrufender Funktion)
(defun JB_PTX:Dbox1:action (key / WERT)
  (cond

    ((= key "JB_1_b1")
     (if (setq Textwert (JB_PTX:DBox2 "Textwert" (cdr(assoc "JB_1_t1" Settings&dbox1)) nil))
       (progn
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 Textwert "JB_1_t1"))
	 (set_tile "JB_1_t1" TextWert)
	 (JB_PTX:Dbox1:action:Reset 'T)
	 )
       )
     )
    ((= key "JB_1_b2")
     (if (setq Textwert (JB_PTX:DBox2 "Texthöhe" (cdr(assoc "JB_1_t2" Settings&dbox1)) (list'(> (atof (vl-string-subst "." "," TextWert&DBox2)) 0.0)"Der Texthöhe muss größer Null sein.")))
       (progn
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 Textwert "JB_1_t2"))
	 (set_tile "JB_1_t2" TextWert)
	 (JB_PTX:Dbox1:action:Reset 'T)
	 )
       )
     )
    ((= key "JB_1_b3")
     (if (setq Textwert (JB_PTX:DBox2 "Offset Vertikal" (cdr(assoc "JB_1_t3" Settings&dbox1)) nil))
       (progn
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 Textwert "JB_1_t3"))
	 (set_tile "JB_1_t3" TextWert)
	 (JB_PTX:Dbox1:action:Reset nil)
	 )
       )
     )
    
    ((= key "JB_1_b5")
     (if (setq Textwert (JB_PTX:DBox2 "Abstandsfaktor" (cdr(assoc "JB_1_t5" Settings&dbox1)) (list'(>= (atof(vl-string-subst "." "," TextWert&DBox2)) 0.0)"Der Abstandsfaktor muss größergleich Null sein.")))
       (progn
	 (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 Textwert "JB_1_t5"))
	 (set_tile "JB_1_t5" TextWert)
	 (JB_PTX:Dbox1:action:Reset 'T)
	 )
       )
     )
     ((= key "JB_1_b6")
     (setq JB_PTX$DCL$_1_po (done_dialog 16))
     )
     ((= key "JB_1_b7")
     (setq JB_PTX$DCL$_1_po (done_dialog 17))
     )
     ((= key "JB_1_b8")
     (setq JB_PTX$DCL$_1_po (done_dialog 18))
     )

    ((= key "JB_1_to1")
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to1"))
     (JB_PTX:Dbox1:action:Reset nil)
     )

    ((= key "JB_1_p1")
     (setq p1_sel&dbox1 (atoi $value))
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (car(nth p1_sel&dbox1 TextStyles&dbox1))"JB_1_p1"))
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (cdr(nth p1_sel&dbox1 TextStyles&dbox1))"JB_1_p1_Style4EntmakeList"))
     (JB_PTX:Dbox1:action:Reset 'T)
     )
    
    ((and(member key '("JB_1_r1" "JB_1_r2" "JB_1_r3" ))
         (= $value "1"))
      (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1
			     (cond ((= key "JB_1_r1")0)((= key "JB_1_r2")1)((= key "JB_1_r3")2))"JB_1_r1-3"))
      (JB_PTX:Dbox1:action:Reset 'T))
     ((and(member key '("JB_1_r4" "JB_1_r5"))
         (= $value "1"))
      (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1
			     (cond ((= key "JB_1_r4")0)((= key "JB_1_r5")1))"JB_1_r4-5"))
      (JB_PTX:Dbox1:action:Reset 'T))
    
     ((= key "accept")      
     (setq JB_PTX$DCL$_1_po (done_dialog 1)))
    ((= key "cancel")      
     (setq JB_PTX$DCL$_1_po (done_dialog 99)))
     )
    )


;;;DBox1: setten
(defun JB_PTX:Dbox1:set ( / X)

  
  (mapcar '(lambda(X)(set_tile (strcat "JB_1_"(car X))(cadr X)))
    (list
      (list "r1" (if(=(cdr(assoc "JB_1_r1-3" Settings&dbox1))0)"1" "0"))
      (list "r2" (if(=(cdr(assoc "JB_1_r1-3" Settings&dbox1))1)"1" "0"))
      (list "r3" (if(=(cdr(assoc "JB_1_r1-3" Settings&dbox1))2)"1" "0"))
      (list "r4" (if(=(cdr(assoc "JB_1_r4-5" Settings&dbox1))0)"1" "0"))
      (list "r5" (if(=(cdr(assoc "JB_1_r4-5" Settings&dbox1))1)"1" "0"))
      (list "t1" (cdr(assoc "JB_1_t1" Settings&dbox1)))
      (list "t2" (cdr(assoc "JB_1_t2" Settings&dbox1)))
      (list "t3" (cdr(assoc "JB_1_t3" Settings&dbox1)))      
      (list "t5" (cdr(assoc "JB_1_t5" Settings&dbox1)))      
      (list "to1" (cdr(assoc "JB_1_to1" Settings&dbox1)))
      )
    )

  (start_list "JB_1_p1" 3)
  (mapcar 'add_list (mapcar 'car TextStyles&dbox1))
  (end_list)
  (set_tile "JB_1_p1" (itoa p1_sel&dbox1))

           
  )
;;;DBox1, moden
(defun JB_PTX:Dbox1:mode ( / )
  (if (not (and vla-poly&Dbox1 Startpkt&DBox1))
    (progn
      (mode_tile "JB_1_b8" 1)
      (mode_tile "accept" 1)
      (mode_tile "JB_1_b7" 2))
    (progn
      (mode_tile "JB_1_b8" 0)
      (mode_tile "accept" 0)
      (mode_tile "JB_1_b7" 0))
    )
  )



;;;Poly picken:
(defun JB_PTX:Dbox1:GetPoly ( / OBJ P VLA-OBJ)
  (if (and(setq obj(entsel "\nPicken Sie eine Polylinie:"))
	  (setq p (cadr obj))
	  (setq obj (car obj))
	  (setq vla-obj (vlax-ename->vla-object obj))
	  (or (member (vla-get-ObjectName vla-obj) '( "AcDb2dPolyline" "AcDbPolyline"))
	      (alert "Die Polylinie muss eine 2D-Polylinie sein.")
	      )
	  )
    (progn
      (setq vla-poly&Dbox1 vla-obj
	    Startpkt&DBox1 (vlax-curve-getClosestPointTo vla-obj (trans p 1 0)))
      (mapcar 'vla-delete (mapcar 'car vla-TextList&Dbox1))
      (setq vla-TextList&Dbox1 nil)
      (setq vla-TextListPoly&Dbox1 nil)
      )
      

    (if (and vla-poly&Dbox1 (not Startpkt&DBox1))
      (alert "Aus dem Pickpunkt konnte kein Texteinfügepunkt auf der Polylinie abgeleitet werden."))

    )
  )

;;;Einfügepunkt für Text picken
(defun JB_PTX:Dbox1:PickPoint ( / P)
  (if(and(setq p (getpoint "\nPicken Sie den Einfügepunkt:"))
	 (setq p (vlax-curve-getClosestPointTo vla-poly&Dbox1 (trans p 1 0)))
	 )
    (progn
      (setq Startpkt&DBox1 p)
      'T)
    (alert "Aus dem Pickpunkt konnte kein Texteinfügepunkt auf der Polylinie abgeleitet werden.")
    )
  )


;;;Rückgabe der Welt-Rahmen-Koordinaten eines Textes/Attributes
(defun JBf:TextBox:EckpunkteWelt:PTX:Faktor (Txtobj Texthoehe AddWertX / A BASIS P1 P2 P3 P4 TBKOORD WINKEL)
  
  (setq tbKoord (textbox (entget Txtobj))
        basis (cdr (assoc 10 (entget Txtobj)))
        winkel (cdr (assoc 50 (entget Txtobj)))
        p1 (polar '(0.0 0.0) (+ (angle '(0.0 0.0) (car tbKoord)) winkel) (distance '(0.0 0.0) (car tbKoord)))
        p2 (polar p1 winkel (- (car (cadr tbKoord)) (car (car tbKoord))))
        p3 (polar p2 (+ winkel (* pi 0.5)) (- (cadr (cadr tbKoord)) (cadr (car tbKoord))))
        p4 (polar p3 (+ winkel pi) (- (car (cadr tbKoord)) (car (car tbKoord))))
  )

  
  (mapcar '(lambda (A) (mapcar '+ basis A))
	  (cond ((or(= (cdr(assoc 1 (entget Txtobj)))" ")
		    (not(vl-remove-if '(lambda(X)
					 (equal (distance X p1) 0.0 0.0001))
			  (list p2 p3 p4))))
		 (list
		   (polar p1 (+ (cdr(assoc 50 (entget Txtobj)))pi)(if (= AddWertX 0.0)(* Texthoehe 0.1)(* AddWertX 2.0)))
		   (polar p1 (+ (cdr(assoc 50 (entget Txtobj)))0.0)(if (= AddWertX 0.0)(* Texthoehe 0.1)(* AddWertX 2.0)))
		   (polar(polar p1 (+ (cdr(assoc 50 (entget Txtobj)))0.0)(if (= AddWertX 0.0)(* Texthoehe 0.1)(* AddWertX 2.0)))
			 (+(cdr(assoc 50 (entget Txtobj)))(* 0.5 pi))(if (= AddWertX 0.0)(* Texthoehe 0.1)(* AddWertX 2.0)))
		   (polar(polar p1 (+ (cdr(assoc 50 (entget Txtobj)))pi)(if (= AddWertX 0.0)(* Texthoehe 0.1)(* AddWertX 2.0)))
			 (+(cdr(assoc 50 (entget Txtobj)))(* 0.5 pi))(if (= AddWertX 0.0)(* Texthoehe 0.1)(* AddWertX 2.0)))))
		('T
		 (list
		   (polar p2 (+(angle p1 p4)(* pi 0.5))(+(distance p2 p1)AddWertX))
		   (polar p1 (-(angle p1 p4)(* pi 0.5))(+(distance p1 p2)AddWertX))
		   (polar p4 (-(angle p1 p4)(* pi 0.5))(+(distance p4 p3)AddWertX))
		   (polar p3 (+(angle p1 p4)(* pi 0.5))(+(distance p3 p4)AddWertX))))
		)

  )
)

;;;Text erzeugen als einzelne Buchstaben
(defun JB_PTX:Dbox1:TextListe ( / P SPACE VLA-TEXT X)
  (setq Space (JB_PTX:Dbox1:CurrentSpace))
  
  (setq vla-TextList&Dbox1
	 (mapcar '(lambda(X)
		    (setq vla-text(vla-AddText Space (vl-list->string (list X))
				    (vlax-3d-point '(0 0 0)) (atof(cdr(assoc "JB_1_t2" Settings&dbox1)))))
		    (vla-put-layer vla-text (if (=(cdr(assoc "JB_1_r4-5" Settings&dbox1))0)
					      (getvar "CLAYER")
					      (vla-get-layer vla-poly&Dbox1)))
		    (vla-put-color vla-text 256)
		    (vla-put-StyleName vla-text (cdr(assoc "JB_1_p1" Settings&dbox1)))
		    (setq p (vla-get-InsertionPoint vla-text))
		    ;;;10 = Mitte Zentrisch
		    (vla-put-alignment vla-text 10)
		    (vla-move vla-text (vla-get-InsertionPoint vla-text)p)
		    (vla-update vla-text)
		    vla-text
		    (list vla-text (JBf:TextBox:EckpunkteWelt:PTX:Faktor (vlax-vla-object->ename vla-text)(atof(cdr(assoc "JB_1_t2" Settings&dbox1)))(* (atof(cdr(assoc "JB_1_t2" Settings&dbox1))) (atof(cdr(assoc "JB_1_t5" Settings&dbox1))))))
		    )
	  (vl-string->list (cdr(assoc "JB_1_t1" Settings&dbox1)))))


  )


;;;Texte auf Position schieben anhand der textbox-Werte
(defun JB_PTX:Dbox1:TextListe:Move ( / N X XWERT)
  (setq xWert (car(car(cadr (car vla-TextList&Dbox1)))))
  (setq n 0)
  (mapcar '(lambda(X)
	     (setq n (+ n 1))
	     (if (> n 1)
	       (vla-move (car X)(vlax-3d-Point (list (car(car(cadr X))) 0.0 0.0))(vlax-3d-Point (list xWert 0.0 0.0)))
	       )
	     ;;(vla-put-visible (car X):vlax-false)
	     (vla-Update (car X))
	     (JBf_list_xdaten_append "JB_PTX" (vlax-vla-object->ename (car X))(list (cons 1070 0)))
	     (setq xWert (+ xWert (-(car(cadr(cadr X)))(car(car(cadr X))))))
	     )
	  vla-TextList&Dbox1)
  )
  


;;;aus erzeugten Texten werden die Stationen in die Textliste geschrieben, bezogen auf eine gerade Linie durch die Ausrichtungspunkte
(defun JB_PTX:Dbox1:TextListe:Stats ( / P VLA-LINE X)
  (entmake (list(cons 0 "LINE")
		(cons 10 (vlax-get (car(car vla-TextList&Dbox1)) 'TextAlignmentPoint))
		(cons 11 (vlax-get (car(last vla-TextList&Dbox1)) 'TextAlignmentPoint))
		(cons 60 1)))
  (setq vla-line(vlax-ename->vla-object(entlast)))

  (setq vla-TextList&Dbox1
	 (mapcar '(lambda(X)
		    (append X
			    (list(if (setq p(vlax-curve-getClosestPointTo vla-line (vlax-get (car X) 'TextAlignmentPoint)))
				   (vlax-curve-getDistAtPoint vla-line p)))))
		 vla-TextList&Dbox1))

  (vla-delete vla-line)
  )


;;;Steigung: FirstDeriv
(defun JB_PTX:Dbox1:Poly:Steigung (p / STG TEMP)
  (setq temp (vlax-curve-getFirstDeriv vla-poly&Dbox1
	       (vlax-curve-getParamAtPoint vla-poly&Dbox1
		 (vlax-curve-getClosestPointTo vla-poly&Dbox1 p)
		 )))
  (angle (if temp temp koord)'(0 0 0))
  )

;;;Station
(defun JB_PTX:Dbox1:Poly:Dist (p / STG TEMP)
  (vlax-curve-getDistAtPoint vla-poly&Dbox1 p)
  )

;;;Point At Stat
(defun JB_PTX:Dbox1:Poly:PointAtStat (stat / )
  (vlax-curve-getpointAtDist vla-poly&Dbox1 stat)  
  )

;;;Texte auf Poly übertragen
(defun JB_PTX:Dbox1:Texts2Poly ( / L N P STATSTART STATWERTLIST STG X)
  (setq l (caddr(last vla-TextList&Dbox1)))
  (setq StatStart (JB_PTX:Dbox1:Poly:Dist Startpkt&DBox1))

  (if (=(cdr(assoc "JB_1_to1" Settings&dbox1))"0")
    (cond ((= (cdr(assoc "JB_1_r1-3" Settings&dbox1))0);;;Links
	   (setq StatWertList
		  (mapcar '(lambda(X)
			     (+ X StatStart))
			  (mapcar 'caddr vla-TextList&Dbox1))))
	  ((= (cdr(assoc "JB_1_r1-3" Settings&dbox1))1);;;Zentrisch
	   (setq StatWertList
		  (mapcar '(lambda(X)
			     (+(- X (/ l 2.0))StatStart))
			  (mapcar 'caddr vla-TextList&Dbox1))))
	  ((= (cdr(assoc "JB_1_r1-3" Settings&dbox1))2);;;Rechts
	   (setq StatWertList
		  (mapcar '(lambda(X)
			     (+(- X l)StatStart))
			  (mapcar 'caddr vla-TextList&Dbox1))))
	  )
	
  (cond ((= (cdr(assoc "JB_1_r1-3" Settings&dbox1))0);;;Links
	 (setq StatWertList
		(mapcar '(lambda(X)
			   (- StatStart X))
			(mapcar 'caddr vla-TextList&Dbox1))))
	 ((= (cdr(assoc "JB_1_r1-3" Settings&dbox1))1);;;Zentrisch
	 (setq StatWertList
		(mapcar '(lambda(X)
			   (+ (- StatStart X) (/ l 2.0)))
			(mapcar 'caddr vla-TextList&Dbox1))))
	((= (cdr(assoc "JB_1_r1-3" Settings&dbox1))2);;;Rechts
	 (setq StatWertList
		(mapcar '(lambda(X)
			   (+ (- StatStart X) l))
			(mapcar 'caddr vla-TextList&Dbox1))))
	)
    )

  (setq n -1)
  (setq vla-TextListPoly&Dbox1
	 (mapcar '(lambda(X)
		    (setq n (+ n 1))
		    (if (and(>=(nth n StatWertList)0.0)
			    (<=(nth n StatWertList)(vla-get-length vla-poly&Dbox1))
			    (setq p (JB_PTX:Dbox1:Poly:PointAtStat (nth n StatWertList)))
			    (setq Stg (JB_PTX:Dbox1:Poly:Steigung p))
			    (setq Stg
				   (if (=(cdr(assoc "JB_1_to1" Settings&dbox1))"0")
				     (+ Stg pi)
				     Stg)))
		      (progn

			(setq p (polar p (+ Stg (* 0.5 pi))(atof (cdr(assoc "JB_1_t3" Settings&dbox1)))))
			(vla-move (car X) (vla-get-TextAlignmentPoint (car X))
				  (vlax-3D-Point p))
			(vla-put-rotation (car X) Stg)
			(JBf_list_xdaten_append "JB_PTX" (vlax-vla-object->ename (car X))(list (cons 1070 1)))
			;;(vla-put-visible (car X) :vlax-true)
			(vla-update (car X))
			(list (car X)p Stg)
			)
		      (list (car X)nil nil)
		      )
		    )
		 vla-TextList&Dbox1))
  )
  
;;;:Reset für Einstellungsänderung
(defun JB_PTX:Dbox1:action:Reset (NeueTexteFlag / )
  (if (and vla-poly&Dbox1 Startpkt&DBox1)
    (if NeueTexteFlag
	(progn
	  (mapcar 'vla-delete (mapcar 'car vla-TextList&Dbox1))
	  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1
				 (cdr(nth p1_sel&dbox1 TextStyles&dbox1))
				 "JB_1_p1_Style4EntmakeList"))
	  (if (not(tblsearch "STYLE" (car (nth p1_sel&dbox1 TextStyles&dbox1))))
	    (entmake (cdr(assoc "JB_1_p1_Style4EntmakeList" Settings&dbox1)))
	    )
	
	  (setq vla-TextList&Dbox1 nil
		vla-TextListPoly&Dbox1 nil)
	  (JB_PTX:Dbox1:TextListe)
	  (JB_PTX:Dbox1:TextListe:Move)
	  (JB_PTX:Dbox1:TextListe:Stats)
	  (JB_PTX:Dbox1:Texts2Poly)
	  )
	(JB_PTX:Dbox1:Texts2Poly)
	)
    )
  )

;;;DBox2, Textwert eingeben
(defun JB_PTX:Dbox2 (label&DBox2 TextWert&DBox2 CheckFunc&DBox2 / DclId ok)
  
  (while (not (member ok '(1 99)))
    (setq DclId (JBf_Dcl:Load_dialog JB_PTX_$DCL$_File "JB_PTX_2" JB_PTX$DCL$_2_po))
    (set_tile "JB_2" label&DBox2)
    (set_tile "JB_2_e1" TextWert&DBox2)
    (mode_tile "JB_2_e1" 2)
    
    (mapcar '(lambda (A) (action_tile A (strcat "(JB_PTX:Dbox2:action \"" A "\")")))
            '("accept"              
              "cancel"
             )
      )
    (setq ok (start_dialog))
    (unload_dialog DclId)

    (if (and CheckFunc&DBox2
	     (= ok 1))
      (if (not(eval (car CheckFunc&DBox2)))
	(progn
	  (setq ok -1)
	  (alert (cadr CheckFunc&DBox2))
	  )
	)
      )
    )
  (if (= ok 1)
    TextWert&DBox2))

;;;DBox2, action
(defun JB_PTX:Dbox2:action (key / )
  (cond
     ((= key "accept")
      (setq TextWert&DBox2 (get_tile "JB_2_e1"))
     (setq JB_PTX$DCL$_1_po (done_dialog 1)))
    ((= key "cancel")      
     (setq JB_PTX$DCL$_1_po (done_dialog 99)))
     )
    )
;;;DCL-schreiben
(defun JB_PTX:dcl:Write ( / file)  
  (if (and (setq JB_PTX_$DCL$_File (vl-filename-mktemp (strcat "PTX.dcl")))
           (setq file (open JB_PTX_$DCL$_File "w"))
      )
    (progn
      (mapcar '(lambda (A)
                       (write-line A file)
               )
              (mapcar '(lambda (A)
                               (strcat "\n" A)
                       )
              (list
                "//Hauptdialog"
                "JB_PTX_1: dialog {label = \"Polylinien-Texte\";"
                ":boxed_column {label = \"Text-Optionen\";"
                ":row {"
                ":button {key = \"JB_1_b1\"; label = \"&Textwert...\";}"
                ":text {key = \"JB_1_t1\"; label = \"MeinText\";width = 80;}}"
                ":radio_row {"
                ":radio_button {key = \"JB_1_r1\"; label = \"Links\";}"
                ":radio_button {key = \"JB_1_r2\"; label = \"Zentrisch\";}"
                ":radio_button {key = \"JB_1_r3\"; label = \"Rechts\";}}"
                ":spacer {height=1;}"
                ":row {"
                ":column {"
                ":row {"
                ":button {key = \"JB_1_b2\"; label = \"Text&höhe...\";width =20;}"
                ":text {key = \"JB_1_t2\"; label = \"0.625\";width = 10;}}"
                ":row{"
                ":button {key = \"JB_1_b3\"; label = \"Offset &Vertikal...\";width =20;}"
                ":text {key = \"JB_1_t3\"; label = \"0.0\";width = 10;}}"                
                ":row{"
                ":button {key = \"JB_1_b5\"; label = \"Abstands&faktor...\";width =20;}"
                ":text {key = \"JB_1_t5\"; label = \"0.0\";width = 10;}}"
                "}"
                ":column {"
                ":popup_list {key = \"JB_1_p1\"; label = \"Textstil\"; edit_width = 45;}"
                ":radio_column{"
                ":spacer {height=1;}"
                ":radio_button {key = \"JB_1_r4\"; label = \"Text auf aktuellen Layer\";}"
                ":radio_button {key = \"JB_1_r5\"; label = \"Text auf Polylinien-Layer\";}}"                
                "}"
                "}"
                "}"
                ":row{fixed_width = true;alignment = centered;"
                ":toggle {key = \"JB_1_to1\"; label = \"Richtungsumkehr\";}"
                ":button {label = \"&Polylinie picken<\"; key= \"JB_1_b7\"; is_cancel = true;}"
                ":spacer {width=2;}"
                ":button {label = \"P&unkt picken<\"; key= \"JB_1_b8\"; is_cancel = true;}"
                ":spacer {width=2;}"
                ":retirement_button {label = \"O&K\"; key= \"accept\"; is_cancel = true;}"
                ":spacer {width=2;}"
                ":retirement_button {label = \"&Ende\"; key= \"cancel\"; is_cancel = true;}"
                ":spacer {width=2;}"
                ":button {label = \"&Zoom<\"; key= \"JB_1_b6\"; is_cancel = true;}"
                "}"
                "}"
                "JB_PTX_2: dialog {key = \"JB_2\";"
                ":boxed_column {label = \"Bitte Wert eingeben\";"
                ":edit_box {key = \"JB_2_e1\"; edit_width = 80;allow_accept=true;}}"
                "ok_cancel;}"


                

               )
              )
      )
      (close file)
      JB_PTX_$DCL$_File
    )
  )
)
;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine verwaltungstechnische Funktionen							   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Fehlermeldung
;;;Fehlermeldung;;;
(defun JBf_Error  (s)
  (print (strcat "***Fehler*** " s))
  (JBf_Reinit))

;;;Initialisierungsfunktion
(defun JBf_init (InitVaris / )
  (setq	JB_Error *error*
        *error* JBf_Error)
  (vl-load-com)
  ;;;Systemvariablen aktuelle Einstellungen für ReInit speichern
  (setq JBf$ReInit$Varis
         (mapcar '(lambda(A)
                    (list (car A)(getvar (car A))))InitVaris))
  ;;;Vorgabeeistellungen für Systemvariablen
  (mapcar '(lambda(A)
             (if (cadr A)
               (setvar (car A)(cadr A))))InitVaris)
  )

;;;Reinitialisierung
(defun JBf_Reinit ( / n)
  ;;;Systemvariablen ReInitialisieren
  (mapcar '(lambda(A)
             (setvar (car A)(cadr A)))JBf$ReInit$Varis)
  (setq JBf$ReInit$Varis nil)
  (princ)
)
;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => Strings								   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;benutzerspezifischer Pfad zum Speichern von Programmeinstellungen auf dem Benutzer von Windows
;;;Übergeben wird der relative Pfad, der hinter den Windows-Pfad angehängt wird. Wenn die Verzeichnisse nicht vorhanden sind werden sie erstellt.
(defun JBf_String:Userpfad:WinUser (UserPfad / )
  
  (setq UserList (JBf_String:Delimiter->List UserPfad "\\"))
  (setq Pfad (strcat "c:\\Users\\"(getvar "LOGINNAME")"\\"))
        

  ;;;wenn UserPfad noch nicht vorhanden, dann erstellen
  (mapcar '(lambda(A)
             (setq Pfad (strcat Pfad A "\\"))
             (if (not (JBf_String:FilePath? Pfad))
               (vl-mkdir Pfad)))
    UserList)
  Pfad
  )
;;;String anhand Trennzeichen in Liste zurückgeben
(defun JBf_String:Delimiter->List (Str Delim / StrList)
  (setq Str (vl-string-left-trim Delim Str)
	Str (vl-string-right-trim Delim Str))
  (if (vl-string-search Delim Str)
    (progn
      (while (vl-string-search Delim Str)
        (setq StrList (cons (substr Str 1 (vl-string-search Delim Str))StrList)
	      Str (vl-string-left-trim Delim(substr Str(+(vl-string-search Delim Str)(+ (strlen Delim)1))))))
      (if (/= Str "")
        (setq StrList (cons Str StrList))))
    (setq StrList (cons Str StrList)))
  (reverse StrList))


;;;Dateipfad prüfen
(defun JBf_String:FilePath? (Pfad / FSO TRUE-FALSE)
  (setq Pfad (if(vl-string-search "." Pfad)(car(fnsplitl  Pfad))Pfad))
  (if (setq FSO (vlax-create-object "Scripting.FilesystemObject"))
    (progn
      (if (vlax-method-applicable-p FSO 'FOLDEREXISTS)
        (setq TRUE-FALSE
               (=(vl-catch-all-apply
                   'vlax-invoke-method
                   (list FSO 'FOLDEREXISTS Pfad)):vlax-true))
        (vlax-release-object FSO))))
  TRUE-FALSE)


(defun JBf_string_fill_prä_zeichen (str n str_fill / )
  (if (<(strlen str)n)
    (repeat (- n(strlen str))
      (setq str (strcat str_fill str))))
  str)
	  
;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => Listen								   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Es wird der GcN-Eintrag gesubst
(defun JBf_list:subst:gc (liste Wert GcN / )
  (subst (cons GcN Wert)(assoc GcN liste)liste))


(defun JBf_list_xdaten_append (art obj liste /)
  (regapp art)
  (entmod (append (entget obj) (list (list -3 (cons art liste)))))
  )

(defun JBf_list_xdaten_read (art obj gc_nr / liste)
  (setq liste (cdr (assoc art (cdr (assoc -3 (entget obj '( "*")))))))
  (if gc_nr
    (cdr (assoc gc_nr liste))
    liste
  )
)

;;;--------------------------------------------------------------------------------------------------------
;;;allgemeine Funktionen => Listen in SIC-Datei sichern  					   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Liste in LSP-Datei sichern
;;;Sichern von Einstellungen, Ausführung
;;;liste => DottetPairList, die es zu sichern gilt
;;;path => vollständiger Dateipfad mit Dateiname
;;;AcadTrustCheck => 'T or NIL, es wird bei 'T ein temnporärer TrustedPath erstellt und danach auch gleich wieder gelöscht
(defun JBf_SIC:sichern (liste FilePath AcadTrustCheck / FILESTREAM X)

  (setq FileStream (open FilePath "w"))
  (write-line "'(" FileStream)
  (mapcar '(lambda (X)
                   (JBf_SIC:sichern:prin1 X FileStream)
           )
          liste
  )
  (write-line ")" FileStream)
  (close FileStream)

  (if
    (if AcadTrustCheck
      (car (JBf_SIC:load:Catch FilePath nil))
      (vl-catch-all-error-p
        (vl-catch-all-apply 'JBf_SIC:load (list FilePath))
      )
    )


    (if (findfile (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
      (progn
        (alert (strcat "Die Sicherungsdatei \n\n"
                       FilePath
                       "\n\n ist fehlerhaft und wird automatisch durch die BAK-Datei\n\n"
                       (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak")
                       "\n\nersetzt."
               )
        )
        (if (vl-file-delete FilePath)
          (vl-file-copy (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak") FilePath)
          (alert (strcat "Die Sicherungsdatei \n\n"
                         FilePath
                         "\n\n ist fehlerhaft und konnte nicht automatisch durch die BAK-Datei\n\n"
                         (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak")
                         "\n\nersetzt werden. Bitte führen Sie diesen Arbeitsgang manuell durch."
                 )
          )
        )
      )

      (alert (strcat "Die Sicherungsdatei \n\n"
                     FilePath
                     "\n\n ist fehlerhaft, bitte löschen Sie diese, anderfalls kann das Programm nicht mehr\n"
                     "ordnungsgemäß starten."
             )
      )
    )
    (if (findfile (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
      (if (vl-file-delete (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
        (vl-file-copy FilePath (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
        (alert (strcat "Für die Sicherungsdatei \n\n"
                       FilePath
                       "\n\n konnte keine BAK-Datei erstellt werden. Bitte löschen Sie die vorh. BAK-Datei\n\n"
                       (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak")
                       "\n\nmanuell."
               )
        )
      )
      (vl-file-copy FilePath (strcat (car (fnsplitl FilePath)) (cadr (fnsplitl FilePath)) ".bak"))
    )
  )
)
;;;Laden der Datei um zu prüfen, ob diese korrekt ist!
  (defun JBf_SIC:load (FilePath /)
    (load FilePath)
  )
;;;Pfad muss existieren, Prüfung in aufrufender Funktion und temporärem TrustPath
  (defun JBf_SIC:load:Catch (PathFile ErrMsg / ERROR RETVAL TRUTHPATHSET)
    (if (JBf_AcadSystem:TrustedPaths?)
      (progn
        (setq TruthPathSet 'T)
        (JBf_AcadSystem:TrustedPaths:Add (strcat (car (fnsplitl PathFile)) "..."))
      )
    )

    (setq error (vl-catch-all-error-p
                  (setq RetVal (vl-catch-all-apply 'JBf_SIC:load (list PathFile)))
                )
    )
    (if (and error ErrMsg)
      (alert ErrMsg)
    )

    (if TruthPathSet
      (JBf_AcadSystem:TrustedPaths:Delete (strcat (car (fnsplitl PathFile)) "..."))
    )
    (list error RetVal)
  )
;;;Iteratives lustiges Listenschreiben
  (defun JBf_SIC:sichern:prin1 (A FileStream / B)

    (cond  ;;;wenn einzelner Eintrag
                 ((atom A)
                        (write-line (vl-prin1-to-string A) FileStream)
                 )
      ((and (atom (car A)) (not (cdr A)))  ;;;GC ohne Wert
            (write-line (vl-prin1-to-string A) FileStream)
      )
      ((and (atom (car A)) (cdr A) (not (listp (cdr A))))  ;;;DottedPair
            (write-line (vl-prin1-to-string A) FileStream)
      )
      ((and (atom (car A)) (cdr A) (listp (cdr A)) (= (length (cdr A)) 1) (atom (car (cdr A))))  ;;;GC + Wert
            (write-line (strcat "(" (vl-prin1-to-string (car A))) FileStream)
            (mapcar '(lambda (B)
                             (JBf_SIC:sichern:prin1 B FileStream)
                     )
                    (cdr A)
            )
         (write-line ")" FileStream)
      )
      ((and (atom (car A)) (cdr A) (listp (cdr A)))  ;;;GC + Liste
            (write-line (strcat "(" (vl-prin1-to-string (car A))) FileStream)
            (mapcar '(lambda (B)
                             (JBf_SIC:sichern:prin1 B FileStream)
                     )
                    (cdr A)
            )
         (write-line ")" FileStream)
      )
      ( 'T
        (write-line "(" FileStream)
        (mapcar '(lambda (B)
                         (JBf_SIC:sichern:prin1 B FileStream)
                 )
                A
        )
         (write-line ")" FileStream)
      )
    )
  )             

;;;--------------------------------------------------------------------------------------------------------
;;;Setzen von "TrustedPaths's" sab ACAD  2014								   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Prüfen, ob bereits TrustedPaths in der aktuelle Version verwendet werden können
(defun JBf_AcadSystem:TrustedPaths? ( / )
  (and (= "ACAD" (strcase (getvar "PROGRAM"))) (getvar "SECURELOAD"))
  )

;;;Pfadangaben immer mit BackSlashes, "\\..." hinten angestellt, damit alle untergeordneten Verzeichnisse berücksichtigt werden
(defun JBf_AcadSystem:TrustedPaths:Add (pfad / TRUSTEDPATHS)
  (setq TrustedPaths(if (getvar "TRUSTEDPATHS")(getvar "TRUSTEDPATHS")""))
  (if(not(member (strcase pfad)(mapcar 'strcase (JBfd_AcadSystem:TrustedPath:Split TrustedPaths))))
    (setvar "TRUSTEDPATHS"(strcat TrustedPaths ";" pfad)))
  )

;;;Pfad entfernen
(defun JBf_AcadSystem:TrustedPaths:Delete (pfad / A TRUSTEDPATHS)
  (setq TrustedPaths(if (getvar "TRUSTEDPATHS")(getvar "TRUSTEDPATHS")""))
  (setvar "TRUSTEDPATHS"
	  (vl-string-right-trim ";"(apply 'strcat(mapcar '(lambda(A)
							   (strcat A ";"))
							(vl-remove-if 'not (mapcar '(lambda(A)
										      (if(/= (strcase pfad)(strcase A))A))
										   (JBfd_AcadSystem:TrustedPath:Split TrustedPaths)))))))
  )

;;;String splitten an Semikolons, als Liste zurückgeben
(defun JBfd_AcadSystem:TrustedPath:Split (TrustedPaths / A RETLIST TEMP)
  (mapcar '(lambda(A)
	     (if (/= A 59)
	       (setq temp (cons A temp))
	       (setq RetList (cons (vl-list->string(reverse temp))RetList)
		     temp nil))
	     )
	     (vl-string->list TrustedPaths))
  (if temp
    (setq RetList (cons (vl-list->string (reverse temp))RetList)))
  (reverse RetList))
;;;--------------------------------------------------------------------------------------------------------
;;;allgmeine Funktionen => Dcl									   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;DCL-Dialogfenster laden
(defun JBf_Dcl:Load_dialog (FileName DialogName JB_$DCL$_x_po / DclId)
  (setq DclId (load_dialog FileName))
  (if	JB_$DCL$_x_po
    (if (not (new_dialog DialogName DclId "" JB_$DCL$_x_po))
      (exit))
    (if (not (new_dialog DialogName DclId))
      (exit)))
  DclId
  )


;;;--------------------------------------------------------------------------------------------------------
;;;Info für Textfenster nach dem laden des Programms							   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(princ (strcat
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          "\n|Polylinien-Texte.                                           |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: PTX                                    |"          
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )
(princ)



    

  
  
  
  










      
                       







                  












