
;;;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: 3DPPP - Es werden 3D-Polylininen ausgewählt und diese als vertikale Profile dargestellt,    
;;;optional mit Überhöhung.   										   
;;;Die Profile dienen zur Überprüfung auf Ausreißerhöhen.						   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;globale Variablen:											   
;;;- JB_3DPPP$DCL$_[x]_po (Positionen der Dialogfenster)						   
;;;- JB_3DPPP_$DCL$_File (temporäre DCL-Datei)								   
;;;                                                                              Jörn Bosse, 22.12.24	   
;;;--------------------------------------------------------------------------------------------------------



;;;aufrufenden Funktionen
(defun c:3DPPP ( / )
  (JB_3DPPP)
  )

;;;Intro
(defun JB_3DPPP:Intro (str / )
  (princ "\nerstellt durch Bosse-engineering - www.bosse-engineering.com\n")
  (princ "\n----------------------3DPPP(1.0), 22.12.24--------------------")
  (princ str)
  (princ "\n--------------------------------------------------------------")
  )




;;;Variablenliste
(defun JB_3DPPP:v_liste ( / )
  '(
     ( "DboxSettings" . (
                         ( "Dbox1" .
                            (
                             ("JB_1_e1" . "5");;;Eingabe Innenabstand
                             ("JB_1_e2" . "5");;;Eingabe Kastenabstand
                             ("JB_1_e3" . "1.0");;;Eingabe z-Sklaierung
                             ("JB_1_r1-4" . 0);;;Radio: 0 = Block, 1 = Text, 2 = Punkt 3 = Eingabe
                             ("JB_1_to1" . "0");;;Verbindung belassen
                             
                             )
                          )
                         )
      ))
  )


;;;Pfad für SIC-Datei in Windows-User
(defun JB_3DPPP: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 
                           )"3DPPP_sic.lsp")  ;;;getauscht, z.B. c:\\User\\[WindowsUsername]\\LispData\\acad\\
  )

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

  (setq pfad_ini (JB_3DPPP: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_3DPPP: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_3DPPP:Intro "\n3D-Polylinien, Prüf-Profile.")

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

  (if (JB_3DPPP:Bks-WKS:parallel-p)
    (JB_3DPPP:Dbox1 v_liste pfad_ini)
    )
      
   
  (princ "\nEnde.")
  (JBf_Reinit)
  (setvar "OSMODE" Osmode_Alt)
  (vla-endundomark (vla-get-activedocument(vlax-get-acad-object))) 
  (princ)
  )



;;;Prüfen, ob WKS oder BKS in xy-Ausrichtung zum WKS
(defun JB_3DPPP:Bks-WKS:parallel-p ( / )
  (or(if (/=(getvar "WORLDUCS")1);;;wenn BKS
       (and(equal(caddr(trans '(1 0 0)1 0))0.0 0.0001)
           (equal(caddr(trans '(0 1 0)1 0))0.0 0.0001))
       'T)
  (alert "Für die Verwendung des Programms \"3DPPP\" muss das WKS oder ein BKS, dessen xy-Ebenen-Ausrichtung der xy-Ebenen-Ausrichtung des Weltkoordinatensystems entspricht, aktiv sein.")
     )
  )


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


(defun JB_3DPPP: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
  )

;;;DBox1, Verbindung löschen
(defun JB_3DPPP:Dbox1:Verbindung:Delete ( / )
  (if (and objVerb&DBox1
           (entget objVerb&DBox1))
    (vla-delete (vlax-ename->vla-object objVerb&DBox1))
    )
  )


;;;Aktueller Space für VLA-Kram
(defun JB_3DPPP: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)))
      )
  )

;;;DBox1, Verbindung zeichnen
(defun JB_3DPPP:Dbox1:Verbindung:Add ( / COORDS3DPL COORDSPROFIL VLA-OBJ)
  (JB_3DPPP:Dbox1:Verbindung:Delete)
  (if ProfilList&DBox1
    (progn
      (setq coordsProfil (JBf_VlaObjects:GetKoord (cdr(assoc "vla-obj" ProfilList&DBox1))))
      (setq coords3DPl (JBf_VlaObjects:GetKoord (cdr(assoc "vla-obj3DPl" ProfilList&DBox1))))

      (JB_3DPPP:Dbox1:Poly->Prof:Zeichnen:PolyAdd:StandardLayer nil)

      (setq vla-obj(vla-addLine (JB_3DPPP:Dbox1:CurrentSpace)
                     (vlax-3D-Point (nth (cdr(assoc "NthN" ProfilList&DBox1))coordsProfil))
                     (vlax-3D-Point (nth (cdr(assoc "NthN" ProfilList&DBox1))coords3DPl))
                     )
            )
      (vla-put-layer vla-obj "3DPPP")
      (vla-put-color vla-obj 6)
      (vla-update vla-obj)
      (setq objVerb&DBox1 (vlax-vla-object->ename vla-obj)))
    )
  )       
 
;;;DBox 1
(defun JB_3DPPP:Dbox1 (v_liste pfad_ini / DclId ok Settings&Dbox1 ProfilList&DBox1 NewHeight&DBox1 Error&Dbox1 objVerb&DBox1 pPick)
  (setq Settings&Dbox1 (JB_3DPPP:v_liste:DboxSettings:get "Dbox1" v_liste))

  
  
  (while (not (member ok '(99)))
    (setq DclId (JBf_Dcl:Load_dialog JB_3DPPP_$DCL$_File "JB_3DPPP_1" JB_3DPPP$DCL$_1_po))
    (JB_3DPPP:Dbox1:set)
    (JB_3DPPP:Dbox1:mode)
    (mapcar '(lambda (A) (action_tile A (strcat "(JB_3DPPP: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_to1"
              "JB_1_l1"
              "cancel"
             )
      )
    (setq ok (start_dialog))
    (unload_dialog DclId)

    (cond
      ((= ok 11) ;;;3D-Polyd wählen
       (JB_3DPPP:Dbox1:Poly->Prof)
       (JB_3DPPP:Dbox1:Verbindung:Add)
       )

      ((= ok 12) ;;ProfilLine Picken
       (if(setq pPick(JB_3DPPP:Dbox1:Profil->ProfilList))
         (progn
           (JB_3DPPP:DBox1:ProfilPoint:Mark pPick)
           (JB_3DPPP:Dbox1:Verbindung:Add)
           )
         )
       )

      ((= ok 15) ;;Profilpunkt picken
       (JB_3DPPP:Dbox1:ProfilPoint:Pick)
       )

      ((= ok 16) ;;;Objekt/Punkt für Höhe
       (JB_3DPPP:Dbox1:ObjektOrPoint4z)       
       )

      ((= ok 18)
             (vl-catch-all-apply 'getpoint (list "\nmit ENTER zurück ins Dialogfenster."))
             )
      ((= ok 99) ;;;Ende
       (if (/= (cdr(assoc "JB_1_to1" Settings&Dbox1))"1")
         (JB_3DPPP:Dbox1:Verbindung:Delete)
         )
       (setq v_liste (JB_3DPPP:v_liste:DboxSettings:put "Dbox1" Settings&dbox1 v_liste))
       (JBf_SIC:sichern v_liste pfad_ini nil)
       
       )
      )
    )
  
  )



;;;Block, Text oder Punkt für z picken
(defun JB_3DPPP:Dbox1:ObjektOrPoint4z ( / AWS P Z)
  (cond ((= (cdr(assoc "JB_1_r1-4" Settings&dbox1))0);;;Block
         (if (setq aws (ssget "_:S" (list (cons 0 "INSERT"))))
           (setq z (caddr (vlax-get (vlax-ename->vla-object (ssname aws 0))'InsertionPoint)))))
        ((= (cdr(assoc "JB_1_r1-4" Settings&dbox1))1);;;Text
         (if (setq aws (ssget "_:S" (list (cons 0 "TEXT"))))
           (setq z (atof(vl-string-subst "." ","(vla-get-TextString (vlax-ename->vla-object (ssname aws 0)))))))
         )
        ((= (cdr(assoc "JB_1_r1-4" Settings&dbox1))2);;;Punkt
         (if (setq p (getpoint "\nHöhenpunkt picken:"))
           (progn
             (setq p (trans p 1 0))
             (setq z (caddr p)))
           )
         )
        )

  (if z
    (setq NewHeight&DBox1 z))
  )
        


;;;Profilpunkt mit Linie markieren
(defun JB_3DPPP:DBox1:ProfilPoint:Mark (p / COORDS N X)
  (setq n -1)
  (setq coords(mapcar '(lambda(X)
                         (list (setq n (+ n 1))X))
                (JBf_VlaObjects:GetKoord (cdr(assoc "vla-obj" ProfilList&DBox1)))))
  (setq coords(vl-sort coords '(lambda(e1 e2)(<(distance p (cadr e1))(distance p (cadr e2))))))
  (setq ProfilList&DBox1 (JBf_list:subst:gc ProfilList&DBox1 (car(car coords))"NthN"))
  (JB_3DPPP:Dbox1:Verbindung:Add)
  )


;;;Profilpunkt picken
(defun JB_3DPPP:Dbox1:ProfilPoint:Pick( / P)
  (if (setq p (getpoint "\nPicken Sie einen Punkt auf dem Profil, der nächstgelegene Stützpunkt wird selektiert."))
    (progn
      (setq p (JBf_list_xyz->xy0(trans p 1 0)))
      (JB_3DPPP:DBox1:ProfilPoint:Mark p)
      )
    )
  )

;;;Koordiantenliste aus 3D-Polylinie, wenn nur logisch geschlossen, dann automatisch erster = letzter Punkt
(defun JB_3DPPP:Dbox1:Poly->Prof:aws->vla-objList:coords3DPl (vla-obj / COORDS GEOCLOSEDFLAG)
  (setq coords (JBf_VlaObjects:GetKoord->List 3 nil (vlax-get vla-obj 'Coordinates)))
  (setq GeoClosedFlag(equal (distance(car coords)(last coords))0.0 0.00001));;;wenn geometrisch geschlossen

  (if (and (=(vla-get-closed vla-obj):vlax-true)
           (not (=(vla-get-closed vla-obj):vlax-true)))
    (setq coords (append coords (list (car coords)))))

  (list coords GeoClosedFlag))



;;;Aus PolyAWS nur die 3D-Polylinien in einer Liste zurückgeben
(defun JB_3DPPP:Dbox1:Poly->Prof:aws->vla-objList (aws / COORDS GEOCLOSEDFLAG N RETLIST VLA-OBJ)
  (setq n 0)
  (repeat (sslength aws)
    (setq vla-obj (vlax-ename->vla-object(ssname aws n)))
    (if (=(vla-get-Objectname vla-obj)"AcDb3dPolyline")
      (progn
        (setq coords (JB_3DPPP:Dbox1:Poly->Prof:aws->vla-objList:coords3DPl vla-obj)
              GeoClosedFlag (cadr coords)
              coords (car coords))
        
        (setq RetList (cons (list (cons "vla-obj" vla-obj)
                                  (cons "coords" coords)
                                  (cons "GeoClosedFlag" GeoClosedFlag)
                                  (cons "LogicalClosedFlag" (=(vla-get-closed vla-obj):vlax-true))
                                  (cons "coords2D" (JB_3DPPP:Dbox1:Poly->Prof:aws->vla-objList:ProfCoords coords GeoClosedFlag (=(vla-get-closed vla-obj):vlax-true)))
                                  )RetList))
        )
      )
    (setq n (+ n 1)))
  RetList)

;;;Profilkoordinatenliste
(defun JB_3DPPP:Dbox1:Poly->Prof:aws->vla-objList:ProfCoords (coords GeoClosedFlag LogicalClosedFlag  / COORDS N X)
  (if (and LogicalClosedFlag
           (not GeoClosedFlag))
    (setq coords (append coords (list (car coords)))))

  (setq n -1)
  (mapcar '(lambda(X)
             (setq n (+ n 1))
             (if (= n 0)
               (list 0 0)
               (list (distance (JBf_list_xyz->xy0(nth (- n 1)coords))(JBf_list_xyz->xy0 X))
                     (- (caddr X)(caddr(nth (- n 1)coords))))
                     )
             )
    coords)
  )


;;;Standard-Layer erstellen und entfrieren usw.
(defun JB_3DPPP:Dbox1:Poly->Prof:Zeichnen:PolyAdd:StandardLayer (layer / VLA-LAYER)
   (if (not Layer)
     (if (not (tblsearch "LAYER" "3DPPP"))
       (progn
         (setq vla-layer(vla-add (vla-get-layers(vla-get-activedocument (vlax-get-acad-object)))"3DPPP"))
         (vla-put-color vla-layer 6)
         )
       (setq vla-layer (vla-item(vla-get-layers(vla-get-activedocument (vlax-get-acad-object)))"3DPPP"))
       )
     (setq vla-layer (vla-item(vla-get-layers(vla-get-activedocument (vlax-get-acad-object)))layer))
     )

  (vla-put-lock vla-layer :vlax-false)
  (vla-put-LayerOn vla-layer :vlax-true)
  (if (/= (strcase (getvar "CLAYER"))
          (strcase (vla-get-name vla-layer)))
    (vla-put-freeze vla-layer :vlax-false)
    )
  
  
  )

;;;Rechteck zeichnen
(defun JB_3DPPP:Dbox1:Poly->Prof:Zeichnen:PolyAdd (coords Layer ClosedFlag / COORDSARRAY VLA-OBJ)
  (JB_3DPPP:Dbox1:Poly->Prof:Zeichnen:PolyAdd:StandardLayer Layer)
  
    
  (setq CoordsArray (vlax-make-safearray vlax-vbDouble (cons 0  (-(length coords)1))))
  (vlax-safearray-fill CoordsArray coords)
  (setq vla-obj(vla-addLightweightPolyline (vla-get-modelSpace (vla-get-activeDocument (vlax-get-acad-object)))CoordsArray))
  (vla-put-layer vla-obj (if layer layer "3DPPP"))
  (vla-put-closed vla-obj (if ClosedFlag :vlax-true :vlax-false))
  (vla-update vla-obj)
  vla-obj
  )


;;;max Delta-Y-Wert
(defun JB_3DPPP:Dbox1:Poly->Prof:Zeichnen:DeltaY (YList / )
  (-(apply 'max YList)
    (apply 'min YList)
    )
  )
               

;;;Profil zeichnen => wenn p = NIL, dann nur Profilliste
(defun JB_3DPPP:Dbox1:Poly->Prof:Zeichnen (vla-objList p vla-obj xdaten / InnenAbstand coords COORDS2D KastenAbstand SummeX DeltaY P PLU PSTART RECOORDS W X ZFAKTOR ZList)
  
  (setq w (angle (trans '(0 0 0)1 0)(trans '(1 0 0)1 0)))
  (setq ZFaktor (atof(cdr(assoc "JB_1_e3" Settings&dbox1))))  
  (setq InnenAbstand (atof(cdr(assoc "JB_1_e1" Settings&dbox1))))
  (setq KastenAbstand (atof(cdr(assoc "JB_1_e2" Settings&dbox1))))
  (if p(setq p (polar p (- w (* 0.5 pi)) Kastenabstand)))

        
  
  (mapcar '(lambda(X)
             (setq n -1)
             (setq coords (cdr(assoc "coords" X)))
             (setq coords2D (mapcar '(lambda(X)
                                       (setq n (+ n 1))
                                       (list
                                         (car X)
                                         (* (cadr X)ZFaktor)
                                         (*(caddr(nth n coords))ZFaktor)
                                         )
                                       )
                              (cdr(assoc "coords2D" X))))
             (setq DeltaY (*(JB_3DPPP:Dbox1:Poly->Prof:Zeichnen:DeltaY (mapcar 'caddr coords))ZFaktor))
             (setq SummeX (apply '+ (mapcar 'car coords2D)))

             (if p
               (progn
                 (setq ReCoords (mapcar 'JBf_list_xyz->xy
                                  (list (setq plu(polar p (- w (* 0.5 pi))(+ (* InnenAbstand 2.0)DeltaY)))
                                        (polar plu w (+ (* InnenAbstand 2.0)SummeX))
                                        (polar p w (+ (* InnenAbstand 2.0)SummeX))
                                        p)))
                 (JB_3DPPP:Dbox1:Poly->Prof:Zeichnen:PolyAdd (apply 'append ReCoords) nil 'T)
                 (setq pStart(polar (polar plu (+ w(* 0.5 pi))(-(+ InnenAbstand DeltaY)(- (apply 'max (mapcar 'caddr coords2D))(caddr(car coords2D))))) w InnenAbstand))
                 (setq coords2D (mapcar 'JBf_list_xyz->xy
                                  (mapcar '(lambda(X)
                                             (setq pStart(polar(polar pStart w (car X))(+ w (* 0.5 pi))(cadr X)))
                                             )coords2D)))

                 (setq vla-obj(JB_3DPPP:Dbox1:Poly->Prof:Zeichnen:PolyAdd (apply 'append coords2D) (vla-get-layer(cdr(assoc "vla-obj" X))) nil))
                 (JBf_list_xdaten_append "JB_3DPPP" (vlax-vla-object->ename vla-obj)(setq xdaten(list (cons 1005 (vla-get-Handle(cdr(assoc "vla-obj" X))))
                                                                                                      (cons 1040 ZFaktor))))
                 (setq p (polar plu (- w (* 0.5 pi))KastenAbstand))
                 )
               )
             

             (list (cons "vla-obj" vla-obj)
                   (cons "Xdaten" xdaten)
                   (cons "vla-obj3DPl" (cdr(assoc "vla-obj" X)))                   
                   (cons "ZList" (mapcar 'caddr coords));;;WEITER => ZList hier mit wirklichen Z's bestückt, muss jetzt auch von der :set umgesetzt werden!!!!
                   (cons "NthN" 0))
             )

    
    vla-objList)
  )

  

;;;ProfilList aus gepickter ProfilLinie
(defun JB_3DPPP:Dbox1:Profil->ProfilList ( / OBJ OBJ3D PPICK VLA-OBJ VLA-OBJLIST XDATEN)
  (if(and
      
      (setq obj (entsel "\nPicken Sie eine Profil-Polylinie:"))
      (setq pPick (trans(cadr obj)1 0))
      (setq obj (car obj))
      
      
      (or(=(cdr(assoc 0 (entget obj)))"LWPOLYLINE")
         (alert "Sie haben keine Polylinie gepickt."))
      (setq vla-obj (vlax-ename->vla-object obj))
      (or (setq xdaten (JBf_list_xdaten_read "JB_3DPPP" obj nil))
          (alert "Die gepickte Polylinie war keine gültige Profil-Polylinie."))
      (or(and(handent(cdr(assoc 1005 xdaten)))
             (entget(handent(cdr(assoc 1005 xdaten))))
             (setq obj3D (handent(cdr(assoc 1005 xdaten)))))
         (alert "Die zugeordnete 3D-Polylinie ist nicht vorhanden oder fehlerhaft.")
         )
      (setq vla-objList (JB_3DPPP:Dbox1:Poly->Prof:aws->vla-objList (ssadd obj3D)))
      )
    (setq ProfilList&DBox1(car(JB_3DPPP:Dbox1:Poly->Prof:Zeichnen vla-objList nil vla-obj xdaten)))
    )
  pPick)
    

;;;3D-Polylinien auswählen und in Profile konvertieren
(defun JB_3DPPP:Dbox1:Poly->Prof ( / AWS P VLA-OBJLIST)
  (if (and
        (princ "\nBitte wählen Sie 3D-Polylinien aus:")
        (setq aws (ssget (list (cons 0 "POLYLINE"))))
        (or(setq vla-objList (JB_3DPPP:Dbox1:Poly->Prof:aws->vla-objList aws))
           (alert "Es wurden nur 2D-Polylinien ausgewählt, Sie müssen aber 3D-Polylinien auswählen.")
           )
        )
    (if (setq p (getpoint "\nEinfügepunkt picken:"))
      (setq ProfilList&DBox1(car(JB_3DPPP:Dbox1:Poly->Prof:Zeichnen vla-objList (trans p 1 0)nil nil)))
      )
    )
  )


;;;Nächster Profilpunkt
(defun JB_3DPPP:Dbox1:action:b3 ( / )
  (if (<(cdr(assoc "NthN" ProfilList&DBox1))
        (-(length (cdr(assoc "ZList" ProfilList&DBox1)))1))
    (progn
      (setq ProfilList&DBox1 (JBf_list:subst:gc ProfilList&DBox1 (+(cdr(assoc "NthN" ProfilList&DBox1))1)"NthN"))
      (JB_3DPPP:Dbox1:Verbindung:Add)
      (JB_3DPPP:Dbox1:set)
      (JB_3DPPP:Dbox1:mode)
      )
    (alert "Es ist bereits der letzte Stützpunkt erreicht.")
    )   
  )

;;;Vorheriger Profilpunkt
(defun JB_3DPPP:Dbox1:action:b4 ( / )
  (if (>(cdr(assoc "NthN" ProfilList&DBox1))0)
    (progn
      (setq ProfilList&DBox1 (JBf_list:subst:gc ProfilList&DBox1 (-(cdr(assoc "NthN" ProfilList&DBox1))1)"NthN"))
      (JB_3DPPP:Dbox1:Verbindung:Add)
      (JB_3DPPP:Dbox1:set)
      (JB_3DPPP:Dbox1:mode)
      )
    (alert "Es ist bereits der erste Stützpunkt erreicht.")
    )
  )

;;;Action b7 => geometrisch geschlossen und Nullter oder letzter WErt
(defun JB_3DPPP:Dbox1:action:b7:StartEndFlag-p (coords / )
  (and(equal (distance(car coords)(last coords))0.0 0.00001);;;wenn geometrisch geschlossen
          (or(=(cdr(assoc "NthN" ProfilList&DBox1))0)
             (=(cdr(assoc "NthN" ProfilList&DBox1))(-(length(cdr(assoc "ZList" ProfilList&DBox1)))1))))
  )

;;;Höhenzahl auf Prfoillinie anwenden und auf 3D-Polylinie gleichermaßen
(defun JB_3DPPP:Dbox1:action:b7 ( / COORDS COORDS3D DELTAZ NTHN P STARTENDFLAG X)
  (if (=(cdr(assoc "JB_1_r1-4" Settings&dbox1))3)
      (setq NewHeight&DBox1 (atof(vl-string-subst "." ","(get_tile "JB_1_e4"))))
    )


  (setq DeltaZ (- NewHeight&DBox1
                  (nth (cdr(assoc "NthN" ProfilList&DBox1))(cdr(assoc "ZList" ProfilList&DBox1)))))

  (setq coords3D (JBf_VlaObjects:GetKoord (cdr(assoc "vla-obj3DPl" ProfilList&DBox1))))
  (setq startEndFlag (JB_3DPPP:Dbox1:action:b7:StartEndFlag-p coords3D))
  

  ;;;Profilinie
  (setq coords (mapcar 'JBf_list_xyz->xy(JBf_VlaObjects:GetKoord (cdr(assoc "vla-obj" ProfilList&DBox1)))))
  (mapcar '(lambda(X)
             (setq p (cadr X))
             (setq NthN (car X))
             (setq p (polar p (angle (trans '(0 0 0)1 0)(trans '(0 1 0)1 0))(* (cdr(assoc 1040(cdr(assoc "Xdaten" ProfilList&DBox1))))DeltaZ)))             
             (setq coords (JBf_list_xyz->xy(JBf_list:nth:change coords p NthN)))
             )
    (if startEndFlag
      (list (list 0(car coords))(list (-(length coords)1)(last coords)))
      (list(list (cdr(assoc "NthN" ProfilList&DBox1))(nth (cdr(assoc "NthN" ProfilList&DBox1))coords)))))
  (vlax-put (cdr(assoc "vla-obj" ProfilList&DBox1))'Coordinates (apply 'append coords))
  (vla-update (cdr(assoc "vla-obj" ProfilList&DBox1)))
  

  ;;;3D-Polylinie
  
  (mapcar '(lambda(X)
             (setq p (cadr X))
             (setq NthN (car X))
             (setq p (list (car p)(cadr p)(+(caddr p)DeltaZ)))
             (setq coords3D (JBf_list:nth:change coords3D p NthN))
             )
    (if startEndFlag
      (list (list 0(car coords3D))(list (-(length coords3D)1)(last coords3D)))
      (list(list (cdr(assoc "NthN" ProfilList&DBox1))(nth (cdr(assoc "NthN" ProfilList&DBox1))coords3D)))))

  (vlax-put (cdr(assoc "vla-obj3DPl" ProfilList&DBox1))'Coordinates (apply 'append coords3D))
  (vla-update (cdr(assoc "vla-obj3DPl" ProfilList&DBox1)))

  (setq ProfilList&DBox1 (JBf_list:subst:gc ProfilList&DBox1 (mapcar 'caddr coords3D) "ZList"))

  (JB_3DPPP:Dbox1:Verbindung:Add)
  (JB_3DPPP:Dbox1:set)
  (JB_3DPPP:Dbox1:mode)
  )
  
  
   

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

    ((= key "JB_1_to1")     
     (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 $value "JB_1_to1"))
     )    
    ((= key "JB_1_b1");;;3D_Polylinien auswählen
     (if(JB_3DPPP:Dbox1:get 'T)
       (JB_3DPPP:Dbox1:mode)
       (setq JB_3DPPP$DCL$_1_po (done_dialog 11))
       )
     )
    ((= key "JB_1_b2");;;Profil picken
     (if(JB_3DPPP:Dbox1:get 'T)
       (JB_3DPPP:Dbox1:mode)
       (setq JB_3DPPP$DCL$_1_po (done_dialog 12))
       )
     )
    
    ((= key "JB_1_b3");;;Nächster
     (JB_3DPPP:Dbox1:action:b3)
     )

    ((= key "JB_1_b4");;;Vorheriger
     (JB_3DPPP:Dbox1:action:b4)
     )

    ((= key "JB_1_b5");;;Profilpunkt picken
     (if(JB_3DPPP:Dbox1:get 'T)
       (JB_3DPPP:Dbox1:mode)
       (setq JB_3DPPP$DCL$_1_po (done_dialog 15))
       )
     )

    ((= key "JB_1_b6");;;Objekt oder Punkt picken
     (if(JB_3DPPP:Dbox1:get 'T)
       (JB_3DPPP:Dbox1:mode)
       (setq JB_3DPPP$DCL$_1_po (done_dialog 16))
       )
     )

    ((= key "JB_1_b7");;;Übernehmen
     (JB_3DPPP:Dbox1:action:b7)
     )

       
    ((= key "JB_1_b8");;;Zoom
     (if(JB_3DPPP:Dbox1:get 'T)
       (JB_3DPPP:Dbox1:mode)
       (setq JB_3DPPP$DCL$_1_po (done_dialog 18))
       )
     )
    
    ((and(member key '("JB_1_r1" "JB_1_r2" "JB_1_r3" "JB_1_r4"))
         (= $value "1"))
     (setq NewHeight&DBox1 nil)
     (set_tile "JB_1_e4" (rtos(nth (cdr(assoc "NthN" ProfilList&DBox1))(cdr(assoc "ZList" ProfilList&DBox1)))2 3))
     (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)((= key "JB_1_r4")3))"JB_1_r1-4"))
     (JB_3DPPP:Dbox1:mode)
    )    
    ((= key "cancel") ;;;Ende
     (JB_3DPPP:Dbox1:get nil)
     (setq JB_3DPPP$DCL$_1_po (done_dialog 99)))
     )
    )





;;;DBox1, getten
(defun JB_3DPPP:Dbox1:get (CheckFlag / )
  (setq Error&Dbox1 nil)
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (vl-string-subst "." ","(get_tile "JB_1_e1"))"JB_1_e1"))
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (vl-string-subst "." ","(get_tile "JB_1_e2"))"JB_1_e2"))
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (vl-string-subst "." ","(get_tile "JB_1_e3"))"JB_1_e3"))
  (setq Settings&dbox1 (JBf_list:subst:gc Settings&dbox1 (get_tile "JB_1_e4")"JB_1_e4"))

  (if CheckFlag
    (cond ((< (atof (cdr(assoc "JB_1_e1" Settings&dbox1)))0.0)
           (alert "Der Innenabstand muss größergleich Null sein.")
           (setq Error&Dbox1 "e1"))
          ((< (atof (cdr(assoc "JB_1_e2" Settings&dbox1)))0.0)
           (alert "Der Kastenabstand muss größergleich Null sein.")
           (setq Error&Dbox1 "e2"))
          ((<= (atof (cdr(assoc "JB_1_e3" Settings&dbox1)))0.0)
           (alert "Die Skalierung in z muss größer Null sein.")
           (setq Error&Dbox1 "e3"))
          ))
  Error&Dbox1)
  


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

  
  (mapcar '(lambda(X)(set_tile (strcat "JB_1_"(car X))(cadr X)))
    (list
      (list "r1" (if(=(cdr(assoc "JB_1_r1-4" Settings&dbox1))0)"1" "0"))
      (list "r2" (if(=(cdr(assoc "JB_1_r1-4" Settings&dbox1))1)"1" "0"))
      (list "r3" (if(=(cdr(assoc "JB_1_r1-4" Settings&dbox1))2)"1" "0"))
      (list "r4" (if(=(cdr(assoc "JB_1_r1-4" Settings&dbox1))3)"1" "0"))
      (list "to1" (cdr(assoc "JB_1_to1" Settings&dbox1)))
      (list "e1" (cdr(assoc "JB_1_e1" Settings&dbox1)))
      (list "e2" (cdr(assoc "JB_1_e2" Settings&dbox1)))
      (list "e3" (cdr(assoc "JB_1_e3" Settings&dbox1)))
      (list "e4" (if NewHeight&DBox1
                   (rtos NewHeight&DBox1 2 3)
                   (if ProfilList&DBox1 (rtos(nth (cdr(assoc "NthN" ProfilList&DBox1))(cdr(assoc "ZList" ProfilList&DBox1)))2 3)"")))
      (list "t1" (strcat "Z=" (if ProfilList&DBox1 (rtos(nth (cdr(assoc "NthN" ProfilList&DBox1))(cdr(assoc "ZList" ProfilList&DBox1)))2 3)"")))
      )
    )

           
  )
;;;DBox1, moden
(defun JB_3DPPP:Dbox1:mode ( / )

  (if ProfilList&DBox1
    (progn
      (mode_tile "JB_1_b3" 0)
      (mode_tile "JB_1_b4" 0)
      (mode_tile "JB_1_b5" 0)
      (mode_tile "JB_1_t1" 0)
      (mode_tile "JB_1_r1" 0)
      (mode_tile "JB_1_r2" 0)
      (mode_tile "JB_1_r3" 0)
      (mode_tile "JB_1_r4" 0)
      (if (member(cdr(assoc "JB_1_r1-4" Settings&dbox1))'(0 1 2))
        (mode_tile "JB_1_b6" 0)
        (mode_tile "JB_1_b6" 1)
        )
      (if (=(cdr(assoc "JB_1_r1-4" Settings&dbox1))3)
        (mode_tile "JB_1_e4" 0)
        (mode_tile "JB_1_e4" 1)
        )
      (if (or NewHeight&DBox1
              (=(cdr(assoc "JB_1_r1-4" Settings&dbox1))3))
        (mode_tile "JB_1_b7" 0)
        (mode_tile "JB_1_b7" 1)
        )
      )
    (progn
      (mode_tile "JB_1_b3" 1)
      (mode_tile "JB_1_b4" 1)
      (mode_tile "JB_1_b5" 1)
      (mode_tile "JB_1_t1" 1)
      (mode_tile "JB_1_r1" 1)
      (mode_tile "JB_1_r2" 1)
      (mode_tile "JB_1_r3" 1)
      (mode_tile "JB_1_r4" 1)
      (mode_tile "JB_1_b6" 1)
      (mode_tile "JB_1_e4" 1)
      (mode_tile "JB_1_b7" 1)
      )
    )
  (if Error&Dbox1
    (mode_tile (strcat "JB_1_" Error&Dbox1)2)
    (if (and ProfilList&DBox1
             (=(cdr(assoc "JB_1_r1-4" Settings&dbox1))3))
      (mode_tile "JB_1_e4" 2)
      (mode_tile "JB_1_e3" 2)
      )
    )
  )
;;;DCL-schreiben
(defun JB_3DPPP:dcl:Write ( / file)  
  (if (and (setq JB_3DPPP_$DCL$_File (vl-filename-mktemp (strcat "3DPPP.dcl")))
           (setq file (open JB_3DPPP_$DCL$_File "w"))
      )
    (progn
      (mapcar '(lambda (A)
                       (write-line A file)
               )
              (mapcar '(lambda (A)
                               (strcat "\n" A)
                       )
              (list
                "//Hauptdialog"
                "JB_3DPPP_1: dialog {label = \"3D-Polylinien, Prüfprofile\";"
                ":boxed_column {label = \"Profile erzeugen\";"
                ":edit_box {key = \"JB_1_e1\"; label = \"Innenabstand\"; edit_width = 8;}"
                ":edit_box {key = \"JB_1_e2\"; label = \"Kastenabstand\"; edit_width = 8;}"
                ":edit_box {key = \"JB_1_e3\"; label = \"Skalierung in z\"; edit_width = 8;}"
                ":button  {key = \"JB_1_b1\"; label = \"3&D-Polylinien auswählen<\";fixed_width = true; alignment = right;}"
                "}"
                ":boxed_column {label = \"Profilberbeitung\";"
                ":button {key = \"JB_1_b2\"; label = \"&Profillinie auswählen<\";fixed_width = true; alignment = right;}"
                ":row {"
                ":button {key = \"JB_1_b4\"; label = \"&Vorher\";}"
                ":button {key = \"JB_1_b3\"; label = \"&Nächster\";}"
                ":button {key = \"JB_1_b5\"; label = \"Punkt p&icken<\";}"
                ":text {key = \"JB_1_t1\"; label = \"Z = 123.34\";width=14;}"
                "}"
                ":boxed_column {label = \"neue Höhe\";"
                ":radio_row {"
                ":radio_button {key = \"JB_1_r1\"; label = \"von Block\";}"
                ":radio_button {key = \"JB_1_r2\"; label = \"von Text\";}"
                ":radio_button {key = \"JB_1_r3\"; label = \"Punkt\";}"
                ":radio_button {key = \"JB_1_r4\"; label = \"Eingabe\";}"
                "}"
                ":row {"
                ":button {key = \"JB_1_b6\"; label = \"&Objekt/Punkt<\";}"
                ":edit_box {key = \"JB_1_e4\"; edit_width = 12;}"
                ":button {key = \"JB_1_b7\"; label = \"Ü&bernehmen\";}"
                "}"
                "}"
                "}"
                ":row{fixed_width = true;alignment = centered;"
                ":toggle {key = \"JB_1_to1\"; label = \"Verbindung belassen\";}"
                ":retirement_button {label = \"&Ende\"; key= \"cancel\"; is_cancel = true;}"
                ":spacer {width=2;}"
                ":button {label = \"&Zoom<\"; key= \"JB_1_b8\"; is_cancel = true;}"
                "}"
                "}"

                

               )
              )
      )
      (close file)
      JB_3DPPP_$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)
	  
;;;--------------------------------------------------------------------------------------------------------
;;;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))



;;;Rückgabe als 3-erTripel mit z=0.0
(defun JBf_list_xyz->xy0 (list_xyz / )
  (if (=(length list_xyz)2)
    (reverse(cons 0.0 (reverse list_xyz)))
    (reverse(cons 0.0 (cdr(reverse list_xyz)))))
  )
;;;Rückgabe als 2-erTripel X,Y
(defun JBf_list_xyz->xy (list_xyz / )
  (if (>(length list_xyz)2)
    (reverse(cdr(reverse list_xyz)))
  list_xyz))


(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
  )
)



(defun JBf_list:nth:change(liste EintragNew pos / n )
  (setq n -1)
  (mapcar '(lambda (A)
             (setq n (+ n 1))
             (if (= n pos)
               EintragNew
               A))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
  )

;;;--------------------------------------------------------------------------------------------------------
;;;allgmeine Funktionen => vla									   	   
;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;;;Koordinatenliste umformen
(defun JBf_VlaObjects:GetKoord->List (n z liste / LISTE1 I)
  (setq i (* n -1))
  (repeat (/ (length liste) n)
    (setq i (+ i n))
    (setq liste1 (cons (list (nth i liste) (nth (+ i 1) liste) (if z z (nth (+ i 2) liste))) liste1))
  )
  (reverse liste1)
  )


;;;Koordinaten aus vla-Objekten abfragen
(defun JBf_VlaObjects:GetKoord (vla-obj /)
  (cond
    ((member (vla-get-ObjectName vla-obj) '( "AcDbPolyline" "AcDbLwPolyline"))
             (JBf_VlaObjects:GetKoord->List 2 (vla-get-Elevation vla-obj) (vlax-get vla-obj 'Coordinates))
    )

    ((= (vla-get-ObjectName vla-obj) "AcDb2dPolyline")
        (JBf_VlaObjects:GetKoord->List 3 (vla-get-Elevation vla-obj) (vlax-get vla-obj 'Coordinates))
    )

    ((= (vla-get-ObjectName vla-obj) "AcDb3dPolyline")
        (JBf_VlaObjects:GetKoord->List 3 nil (vlax-get vla-obj 'Coordinates))
    )


    ((= (vla-get-ObjectName vla-obj) "AcDbArc")
        (list
          (vlax-get vla-obj 'StartPoint)
          (polar (vlax-get vla-obj 'Center)
                 (angle (vlax-get vla-obj 'Center)
                        (polar (vlax-get vla-obj 'StartPoint) (angle (vlax-get vla-obj 'StartPoint) (vlax-get vla-obj 'EndPoint))
                               (/ (distance (vlax-get vla-obj 'StartPoint) (vlax-get vla-obj 'EndPoint)) 2.0)
                        )
                 )
                 (vla-get-Radius vla-obj)
          )
              (vlax-get vla-obj 'EndPoint)
        )
    )

    ((= (vla-get-ObjectName vla-obj) "AcDbLine")
        (list
          (vlax-get vla-obj 'StartPoint)
          (vlax-get vla-obj 'EndPoint)
        )
    )
  )
)         





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

(princ (strcat
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          "\n|3D-Polylinien, Prüf-Profile.                                |"
          "\n|------------------------------------------------------------|"
          "\n|erstellt durch Bosse-engineering - www.bosse-engineering.com|"
          "\n|------------------------------------------------------------|"
          "\n|Befehlszeilenaufruf: 3DPPP                                  |"          
          "\n|++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++|"
          )
       )
(princ)









      
                       







                  












