;;;  Dateiname: zinken_3D.lsp  -  erstellt: Thomas Elbracht
;;;  3.2025  -  für AC2023           mail: te@elbracht-web.de
;;;  Aufruf mit: zinken_3D
;;;
;;;  Die Routine erstellt eine Zinkenmusterecke für den Einrichtungsplaner
;;;
;;;  Das Programm wird dem Benutzer so zur Verfügung gestellt, "wie es ist".
;;;  Für eventuelle Programmfehler oder Schäden durch die Anwendung
;;;  wird keine Haftung übernommen.
;;
(defun Te:zinken_3DIni ()
  
  (if *error*				
    (setq *te:error* *error*)		
  )

  (setq cealt (getvar "CMDECHO")
        mealt (getvar "MENUECHO")
	osalt (getvar "OSMODE")
	3dosalt (getvar "3DOSMODE")
	layalt (getvar "CLAYER")
	coalt (getvar "CECOLOR")
	cesalt (getvar "CELTSCALE")
	celalt (getvar "CELTYPE") 
	)
 	(setvar "CMDECHO" 0)
	(setvar "MENUECHO" 0)
  	(setvar "OSMODE" 0)
        (setvar "3DOSMODE" 0)
        (setvar "ORTHOMODE" 0)
        (setvar "DELOBJ" 2)
  	
  (defun *error* (sTxt)	
    (princ (strcat "\n" sTxt))

  (setvar "CMDECHO" cealt)
  (setvar "MENUECHO" mealt)
  (setvar "OSMODE" osalt)
  (setvar "3DOSMODE" 3dosalt)
  (setvar "CLAYER"  layalt)
  (setvar "CECOLOR" coalt)
  (setvar "ORTHOMODE" ortalt)
  (setvar "DELOBJ" delalt)
 
    (if	*te:error*
      (setq *error* *te:error*)	
      (setq *error* nil)
    )
    (princ)
  )
nil
)
(defun TE:zinken_3DDlg ( / dcl_id)
(vl-cmdf "_.view" "S" "TE_VIEW")
(setq next 4)
(setq px (car EP) py (cadr EP) pz (caddr EP))
(setq IMG1 "zinken_3D(logo)"
      fil1 IMG1
  ) 
(if (not dcl_id) (setq dcl_id (load_dialog "zinken_3D")))

  (while (> next 1)
  (new_dialog "zinken_3D" dcl_id)
(TE:zinken_3DTILE)
    (start_image "IMG1") 
    (slide_image 150 -30 220 115 fil1)
    (end_image)  
    (action_tile "EPw" "(done_dialog 2)")
    (action_tile "EPP" "(setq EPP $value)")
    (action_tile "EPX" "(setq px (atoi $value))")
    (action_tile "EPY" "(setq py (atoi $value))")
    (action_tile "EPZ" "(setq pz (atoi $value))")
    (action_tile "DHL" "(setq HL (atoi $value))")
    (action_tile "DBr" "(setq Br (atoi $value))")
    (action_tile "DSt" "(setq St (atoi $value))")
    (action_tile "DANZ" "(setq Anz (atoi $value))")
    (action_tile "DABST" "(setq Abst (atof $value))")
    (action_tile "DFrWi" "(setq FrWi (atof $value))")
    (action_tile "DFrDu" "(setq FrDu (atof $value))")
    (action_tile "DFrLu" "(setq FrLu (atof $value))")
    (action_tile "vView" "(done_dialog 5)")
    (action_tile "DZO" "(setq ZO $value)")
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "cancel" "(done_dialog 0)")
    
(setq next (start_dialog))
(if (= next 2) (TE:zinken_3DDEP))
(if (= next 5)(zin_grv))
    (if (= next 1)
 (if (= EPP "1")
    (progn
      (TE:zinken_3DDEP)
      (TE:zinken_3DZeich)
      )
    (TE:zinken_3DZeich)
    )
       (TE:zinken_3DBack)
  )
    )
  (unload_dialog dcl_id)
)
(defun TE:zinken_3DTILE ()
  (setq brei (dimx_tile "DIA"))
  (setq hoe (dimy_tile "DIA"))
  (start_image "DIA")
  (fill_image 0 0 brei hoe -2)
  (slide_image 0 0 brei hoe (strcat "zinken_3D(zinken_3D)"))
  (end_image)
    (set_tile "EPP" EPP)
    (set_tile "EPX" (rtos px))
    (set_tile "EPY" (rtos py))
    (set_tile "EPZ" (rtos pz))
    (set_tile "DHL" (rtos HL 2 0))
    (set_tile "DBr" (rtos Br 2 0))
    (set_tile "DSt" (rtos St 2 0))
    (set_tile "DANZ" (rtos Anz 2 0))
    (set_tile "DABST" (rtos ABST 2 0))
    (set_tile "DFrWi" (rtos FrWi 2 0))
    (set_tile "DFrDu" (rtos FrDu 2 0))
    (set_tile "DFrLu" (rtos FrLu 2 0))
    (set_tile "DZO" ZO)
)
(defun TE:zinken_3DZeich ()
  (vl-load-com)(setvar "CMDECHO" 0)
   (vl-cmdf "_vpoint" "d" 270.0 90.0)
  (vl-cmdf "_.UCS" "")
  (vl-cmdf "_.PLAN" "")
(setq ss_Zink (ssadd) ss_Schwalb (ssadd) ss_Ecke (ssadd))
  (vl-cmdf "_.LAYER" "_M" "zinken_3DS" "_CO" "32" "zinken_3DS" "")
  (setq LayS (getvar "CLAYER"))
(vl-cmdf "_.LAYER" "_M" "zinken_3DZ" "_CO" "30" "zinken_3DZ" "")
(setq LayZ (getvar "CLAYER"))
(Pu_berech)
(setq RestHL (- HL St))
      (setvar "OSMODE" 0)(setvar "ORTHOMODE" 0)
  (setvar "CLAYER" LayZ)(setq i 0 j 1 k 2 l 3)
(vl-cmdf "_PLINE" (nth i ZirPuli)(nth j ZirPuli)(nth k ZirPuli)(nth l ZirPuli) "s")
  (vl-cmdf "_extrude" (entlast) "" St)
  (ssadd (entlast) ss_Zink)
  (setq m 0 n 1 o 2 p 3 zi 1)
  
 (while (/= zi ZiBerech) 
(vl-cmdf "_PLINE" (nth m ZiPuli)(nth n ZiPuli)(nth o ZiPuli)(nth p ZiPuli) "s")
   (vl-cmdf "_extrude" (entlast) "" St)
   (ssadd (entlast) ss_Zink)
(setq m (+ m 4) n (+ n 4) o (+ o 4) p (+ p 4))
   (setq zi (1+ zi))
)

  (Te:Quad (list (car EP)(cadr EP)(-(caddr EP)RestHL)) Br St RestHL)(ssadd (entlast) ss_Zink)
  (vl-cmdf "_union" ss_Zink "")(ssadd (entlast) ss_Ecke)

  (setvar "CLAYER" LayS)
  
  (setq q 0 r 1 s 2 u 3 Schw 0)
  (setq tom 0)
   (while (/= Schw Anz)
(vl-cmdf "_PLINE" (nth q SchwPuli)(nth r SchwPuli)(nth s SchwPuli)(nth u SchwPuli) "s")
     (vl-cmdf "_extrude" (entlast) "" St)
     (ssadd (entlast) ss_Schwalb)
     (setq q (+ q 4) r (+ r 4) s (+ s 4) u (+ u 4))
  (setq Schw (1+ Schw))
)

 (Te:Quad (list (car EP)(-(cadr EP)RestHL)(caddr EP)) Br RestHL St)(ssadd (entlast) ss_Schwalb)
  (vl-cmdf "_union" ss_Schwalb "")(ssadd (entlast) ss_Ecke)

  (arxload "geom3d")
 (rotate3d ss_Ecke ZLi1 EP 90)
  (vl-cmdf "_rotate" ss_Ecke "" EP 90) 
  (vl-cmdf "_move" ss_Ecke "" (list (-(car EP)St)(-(cadr EP)St)(caddr EP)) EP)
(vl-cmdf "_.view" "H" "TE_VIEW")
  (vl-cmdf "_.zoom" "G" "_.zoom" "0.8x")
    (vl-cmdf "_.view" "Lö" "TE_VIEW")(princ)
  (if (= ZO "1")(Te:zinken_3DZom))
  
)
(defun Pu_berech ()     
 (setq Wil (aib 180) Wio (aib 90.0) Wiu (aib 270.0) Wir 0.0)
    (if(= (tblsearch "view" "TE_VIEW") NIL)
   (vl-cmdf "_.view" "S" "TE_VIEW"))
  (setq ZinkBrU (float(+ FrDu FrLu)))
  (setq SchwalbBrU (/ (- Br(+ (* ABST 2.0) (* (- Anz 1.0) ZinkBrU))) Anz))
  (setq ZiWiLi (aib (+ 90.0 FrWi)) ZiWiRe (aib (- 90.0 FrWi)))
  
  (setq ZLi1 (polar EP Wio St)
	ZLi2 (polar EP Wir ABST)
	SLi1 (polar ZLi2 Wir SchwalbBrU)
	EPr (polar EP Wir Br)
	ZRe1 (polar EPr Wio St)
	SLi2 (polar SLi1 ZiWiRe (* St 2.0))
	SLi3 (inters ZLi1 ZRe1 SLi2 SLi1 nil)
	ZRe2 (polar EPr Wil ABST)
	ZLi3 (polar ZLi2 ZiWiLi (* St 2.0))
	ZLi4 (inters ZLi1 ZRe1 ZLi2 ZLi3 nil)
	SchwalbBOb (distance ZLi4 SLi3)
	3EckB (/(- SchwalbBOb SchwalbBrU)2.0)
	ZRe3 (polar ZRe2 ZiWiRe (* St 2.0))
	ZRe4 (inters ZLi1 ZRe1 ZRe2 ZRe3 nil)
	ZMi1 (polar SLi1 Wir ZinkBrU)
	ZMi2 (polar ZMi1 ZiWiLi (* St 2.0))
	ZMi3 (inters ZLi1 ZRe1 ZMi1 ZMi2 nil)
	ZinkBrOb (distance SLi3 ZMi3)
	ZiBerech (+ Anz 1)
	ZiBr 2
	GrPuli (list ZLi2 ZLi4 SLi1 SLi3 ZRe2 ZRe4)
	ZiPuli (list EP ZLi2 ZLi4 ZLi1)
	SchwPuli (list ZLi2 SLi1 SLi3 ZLi4)
	ZirPuli (list EPr ZRe1 ZRe4 ZRe2)
	)

(if (/= Anz 1)
  (progn
    (setq SchwPtU (polar ZMi1 Wir SchwalbBrU) SchwPtO (polar ZMi3 Wir SchwalbBOb) )
    
  (setq GrPuli (append GrPuli (list ZMi1 ZMi3 SchwPtU SchwPtO)))
    (setq ZiPuli (append ZiPuli (list SLi1 ZMi1 ZMi3 SLi3)))
    (setq SchwPuli (append SchwPuli (list ZMi1 SchwPtU SchwPtO ZMi3)))
    (setq ZiBr (1+ ZiBr))
  ))
(if (> Anz 1)
  (progn
    (setq nSchwu SchwPtU nSchwo SchwPtO)

    (while (/= ZiBr ZiBerech)
    
	(setq nZiu (polar nSchwu Wir ZinkBrU)
	      nZio  (polar nSchwo Wir ZinkBrOb)
	      nSwu (polar nZiu Wir SchwalbBrU)
	      nSwo (polar nZio Wir SchwalbBOb)
	      )
    (setq GrPuli (append GrPuli (list nSchwu nSchwo nZiu nZio)))
    (setq ZiPuli (append ZiPuli (list nSchwu nZiu nZio nSchwo)))
    (setq SchwPuli (append SchwPuli (list nZiu nSwu nSwo nZio)))

    (setq nSchwu nSwu nSchwo nSwo)
      (setq ZiBr (1+ ZiBr))
      )   
))
)
(defun zin_grv ()
  (vl-cmdf "_vpoint" "d" 270.0 90.0)
(redraw)(Pu_berech)
  (setq ZoEp (polar EP (aib 60)  Br))
(command "_.zoom" "M" ZoEP (* Br 2.5))
    (grdraw EP Epr 3)(grdraw EPr ZRe1 3)(grdraw ZRe1 ZLi1 3)(grdraw ZLi1 EP 3)

 (setq g 0 h 1)
  (while (/= g (length GrPuli))
(grdraw (nth g GrPuli) (nth h GrPuli) 1)
(setq g (+ g 2) h (+ h 2))
    )
(TE:zinken_3DTILE)
  
)
(defun Te:zinken_3DZom ()

  (vl-cmdf "_ZOOM" "_W" (getvar "EXTMIN") (getvar "EXTMAX"))
 
	(command "_ZOOM" "0.95x")
        (command "_REGEN")
)
(defun Te:zinken_3DDEP ()
	(setq EP (getpoint "\nGeben Sie den Einfügepunkt an: " )
	px (car EP)
	py (cadr EP)
	pz (caddr EP))
)
(defun Te:Quad (CP laenge breite hoehe)
    (setq ZinkenObj (vlax-get-acad-object))
    (setq Holzliste (vla-get-ActiveDocument  ZinkenObj))
    (setq px (+(car CP) (/ laenge 2.0)) py (+(cadr CP) (/ breite 2.0))  pz (+ (caddr CP)(/ hoehe 2.0)))
    (setq MP (vlax-3d-point px py pz)) 
    (setq modelSpace (vla-get-ModelSpace Holzliste))
    (setq QuadObj (vla-AddBox modelSpace MP laenge breite hoehe))
)
(DEFUN aib (w) (* pi (/ w 180.0)))
(defun Te:zinken_3DBack ()
  (setvar "CMDECHO" cealt)
  (setvar "MENUECHO" mealt)
  (setvar "OSMODE"  osalt)
  (setvar "3DOSMODE" 3dosalt)
  (setvar "CLAYER"  layalt)
  (setvar "CECOLOR" coalt)
  (setvar "CELTSCALE" cesalt)
  (setvar "CELTYPE" celalt)
  (princ)
)
(defun C:zinken_3D ( / dcl_id cealt mealt osalt 3dosalt layalt coalt cesalt celalt next px py pz EP EPP IMG1
		   fil1 brei hoe HL Br St Anz ABST FrWi FrDu FrLu ZO Dn Wil Wio Wiu Wir ss_Zink ss_Schwalb
		   ss_Ecke LayS LayZ RestHL m n o p zi q r s u Schw ZinkBrU SchwalbBrU ZiWiLi ZLi1 ZLi2
		   SLi1 EPr ZRe1 SLi2 SLi3 ZRe2 ZLi3 ZLi4 SchwalbBOb 3EckB ZRe3 ZRe4 ZMi1 ZMi2 ZMi3 ZinkBrOb
		   ZiBerech ZiBr GrPuli ZiPuli SchwPuli ZirPuli SchwPtU SchwPtO nSchwu nSchwo ZoEp g h
		   ZinkenObj Holzliste modelSpace QuadObj)

  (Te:zinken_3DIni)

  (setq HL 200  ; Länge
        Br 90   ; Holzbreite
	St 16   ; Holzdicke	
	Anz 3   ; Anzahl der Schwalben
	ABST 9  ; Zugabe äußere Zinken
	FrWi 10 ; FräserWinkel
	FrDu 15 ; Durchmesser Fräser
	FrLu 1  ; Luft für Fräsvorgang
        ZO "1"  ; Zoomen
        EP '(0.0 0.0 0.0)
	EPP "0"
	)

  (Te:zinken_3DDlg)
  (Te:zinken_3DBack)
(princ)
  )
  (princ "\n  Copyright (c) 2o25 Thomas Elbracht ")
  (princ "\n \t  Aufruf mit zinken_3D")
(princ)


