;;; Dateiname: ACAD-WOODWOP.lsp - erstellt: Dirk Nückel ;;; 05.2002 - für AC15 2002 mail: dirk@dentalmoebel.de ;;; Aufruf mit: CNC ;;; ;;; Die Routine extrahiert Daten für die Holz CNC-Maschinen die mit Woodwop arbeiten ;;; Der Pfad für die NC-Datei wird über Dialogbox ;;; gesucht und gespeichert. ;;; (DEFUN cnclay ( / ) ;Layer setzen für CNC Bearbeitung (command "_layer" "_n" "Bohrung" "FA" 1 "Bohrung" "" ) (command "_layer" "_n" "Verbinder" "FA" 5 "Verbinder" "" ) (command "_layer" "_n" "Kreistasche_durch" "FA" 6 "Kreistasche_durch" "" ) (command "_layer" "_n" "Runden" "FA" 150 "Runden" "" ) (command "_layer" "_n" "Runden-AB" "FA" 190 "Runden-AB" "" ) (command "_layer" "_n" "Schleifen" "FA" 7 "Schleifen" "" ) (command "_layer" "_n" "Fräsen" "FA" 2 "Fräsen" "" ) (command "_layer" "_n" "Text" "FA" 4 "Text" "" ) (command "_layer" "_n" "Horbohr" "FA" 31 "Horbohr" "" ) (command "_layer" "_n" "Kontur" "FA" 32 "Kontur" "" ) );end defun laycnc ; ;*********************************************************************************** ;**** MPR schreiben **** ;*********************************************************************************** ; (defun c:cnc ( / dwgnn dwgn lwpl-daten kreise tasche tasche2 line lb anzbe text44 schleifen runden kontur);Funktion Datei schreiben (COMMAND "_undo" "_begin") (cnclay) (setq dwgn (getfiled "Schreibe WoodWOP MPR in eine Datei" "F://CNC_1" "MPR" 7)) (command "_redraw") (command "_ucs" "_o" pause "" ) ;(strcat (substr (getvar "DWGNAME")1 (-(strlen(getvar "DWGNAME"))4)) ".MPR") ;** Polylinie wählen und alle GruppenCodes außer 10, 42 löschen (setq anzbe 1) (setq dicke(getreal "\n *** Werkzeugdicke *** angeben :\n")) (setq lb (Laenge-Breite-zeigen)) (setq schruppen (finde-LWPL nil)) (setq runden (finde-runden nil)) ; (setq runden-AB (finde-runden-AB nil)) (setq schleifen (finde-schleifen nil)) ; (setq kontur (finde-kontur nil)) (setq kreise (finde-bohrungsKreise nil)) (setq hor (finde-horbohr nil)) (setq hordrm (getreal "\n *** Durchmesser Horizontaler Bohrer *** angeben :\n")) (setq tasche (finde-tasche nil)) (setq line (finde-line nil)) (setq tasche2 (finde-tasche2 nil)) (setq text (finde-text nil)) (header4 dwgn lb dicke) (schreibe-text text dwgn) (schreibe-kreistaschen tasche dwgn);tasche Verbinder (schreibe-line line dwgn );Verbinder linien (schreibe-kreistaschen2 tasche2 dwgn);tasche durchfräsen (schreibe-bohrungen kreise dwgn);Bohrungen (schreibe-schruppen schruppen dwgn );Fräskontur Schlichten und Schruppen (schreibe-runden Runden dwgn );Fräskontur Runden (schreibe-runden-AB runden-AB dwgn );Fräskontur Runden Ablage (schreibe-schleifen schleifen dwgn );Fräskontur Schleifen (schreibe-kontur kontur dwgn);nur Kontur schreiben (schreibe-horbohr hor dwgn) (schreibe-Werkstuck dwgn);Werkstück und Kommentar (schreibe-MPR-Abschluss dwgn);Abschluß! (command "_ucs" "w" "" ) (COMMAND "_undo" "_end") );end defun ; ;----------------------------------------------------------- ;---- Unterfunktionen - bessere Lesbarkeit d. Programms---- ;----------------------------------------------------------- ; ;*********************************************************************************** ;**** header4 **** ;*********************************************************************************** ; ;**** Funktion zum Erzeugen des HEADERS der *.MPR-Datei **** ;**** Einträge sind immer gleich **** (defun header4 (dwgName lb dicke / file ) (setq file (open dwgName "w")) (princ "[H" file) (princ "\nVERSION=" file)(prin1 "4.0 Alpha" file);Version mit Gänsefüßchen (princ "\nOP=" file)(prin1 "1" file) (princ "\nO2=" file)(prin1 "0" file) (princ "\nO4=" file)(prin1 "0" file) (princ "\nO3=" file)(prin1 "0" file) (princ "\nFM=" file)(prin1 "1" file) (princ "\nML=" file)(prin1 "2000" file) (princ "\nGP=" file)(prin1 "0" file) (princ "\nGY=" file)(prin1 "0" file) (princ "\nGXY=" file)(prin1 "0" file) (princ "\nNP=" file)(prin1 "1" file) (princ "\nNE=" file)(prin1 "0" file) (princ "\nNA=" file)(prin1 "0" file) (princ "\nCB=" file)(prin1 "0" file) (princ "\nUP=" file)(prin1 "0" file) (princ "\nDW=" file)(prin1 "0" file) (princ "\nINCH=" file)(prin1 "0" file) (princ "\nVIEW=" file)(prin1 "NOMIRROR" file) (princ "\n_BSX=" file)(prin1 (car lb) file) (princ "\n_BSY=" file)(prin1 (cadr lb) file) (princ "\n_BSZ=" file)(princ dicke file) (princ "\n_FNX=" file)(princ 3.000000 file) (princ "\n_FNY=" file)(princ 3.000000 file) (princ "\n_RNX=" file)(princ 0.000000 file) (princ "\n_RNY=" file)(princ 0.000000 file) (princ "\n_RNZ=" file)(princ 0.000000 file) (princ "\n_RX=" file)(prin1 (+(car lb)3) file) (princ "\n_RY=" file)(prin1 (+(cadr lb)3) file) (princ "\n\n[001" file) (princ "\nL=" file)(prin1 (car lb) file) (princ "\nKM=" file)(prin1 "Länge in X" file) (princ "\nB=" file)(prin1 (cadr lb) file) (princ "\nKM=" file)(prin1 "Breite in Y" file) (princ "\nD=" file)(prin1 dicke file) (princ "\nKM=" file)(prin1 "Dicke des Werkstücks in Z" file) (close file) );end defun ;*********************************************************************************** ;**** schreibe-Schruppen **** ;*********************************************************************************** ; ;**** Function: (schreibe-schruppen ) **** (defun schreibe-schruppen (lwpl-daten datei-name / vertexListe ;** Liste mit nur den GC 10 und 42 anfangsPkt ;** erster Punkt der LW-Polylinie fileDSK ;** Handle der zu bearbeitenden Datei abschittsZahler U-BKS-X U-BKS-Y ) (setq fileDSK (open datei-name"a")) (if (not fileDSK) ((lambda() (alert(strcat"\n\nKann Datei :\""datei-name"\" nicht öffnen.\n")) (exit) )) );end if (foreach polylinie (mapcar'entget lwpl-daten) ;** Gruppen-Codes 10 und 42 raus-filtern (setq vertexListe (vl-remove-if-not '(lambda(einzelner-GC) (member (car einzelner-GC)'(10 42)) ); end LAMBDA polylinie ) anfangsPkt (cdr(assoc 10 vertexListe)) abschittsZahler 1 ); end SETQ (setq U-BKS-X (car (getvar "ucsorg"))) ;verschobenen X Ursprung BKS Merken (setq U-BKS-Y (cadr (getvar "ucsorg")));verschobenen Y Ursprung BKS Merken ;** der Anfangs-Punkt braucht Spezial-Behandlung (princ "\n\n]" fileDSK)(princ anzbe fileDSK) (princ "\n$E0" fileDSK) (princ "\nKP" fileDSK) (princ"\nX="fileDSK)(princ (rtos(-(car anfangsPkt)U-BKS-X)2 4) fileDSK) ;** X= (princ"\nY="fileDSK)(princ (rtos(-(cadr anfangsPkt)U-BKS-Y)2 4) fileDSK) ;** y= (princ"\nZ=0.0"fileDSK) ;** Z= (princ"\nKO=0" fileDSK) ;** KO=0 ;** In Schleifen einzelene Stützpunkte in MPR-Format bringen und in DATEI schreiben (while (< 2(length vertexListe));** Die besteht immer aus einer Folge ;** von Einträgen mit GC 10 gefolgt von einem Eintrag ;** mit GC 42. Deshalb kann nur ;** dann sinnvoll arbeiten, wenn noch DREI Werte ;** übergeben werden können. ;** WICHTIG: Es bleiben garantiert noch 2 Einträge in ;** der übrig. (verabeite-Vertex (cdar vertexListe);** Punkt1 (cdaddr vertexListe);** Punkt2 - GCs 10 und 42 wechseln sich ja ab .. (cdadr vertexListe);** BULGE fileDSK abschittsZahler ) (setq vertexListe (cddr vertexListe));** die beiden führenden Einträge sind schon verarbeitet (setq abschittsZahler (1+ abschittsZahler));** für den nächsten Abschnitt ); end WHILE:sollange noch Stützpunkte abzuarbeiten sind ;** Testen ob geschlossen ;** wenn geschlossen den Anfangs-Punkt nochmal ans Ende (if (lwpl-closed? polylinie) (verabeite-Vertex (cdar vertexListe);** Punkt1 anfangsPkt ;** Punkt2 - GCs 10 und 42 wechseln sich ja ab .. (cdadr vertexListe);** BULGE fileDSK abschittsZahler ;** stimmt schon, weil in der WHILE-Schleife hochgez. ) ); end IF: ist die LW-Polyline geschlossen?? ;** Fräsen Schruppen (princ"\n"fileDSK);** Leerzeile (princ"\n<105 \\Konturfraesen\\"fileDSK) (princ"\nEA=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ ":0\"" fileDSK) (princ"\nMDA=\"TAN\""fileDSK) (princ"\nRK=\"WRKL\""fileDSK) (princ"\nEE=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ "\:" fileDSK)(princ (if(lwpl-closed? polylinie) abschittsZahler (- abschittsZahler 1)) fileDSK)(princ "\"" fileDSK) (princ"\nMDE=\"TAN_AB\""fileDSK) (princ"\nEM=\"0\""fileDSK) (princ"\nRI=\"1\""fileDSK) (princ"\nTNO=\"104\""fileDSK) (princ"\nSM=\"0\""fileDSK) (princ"\nS_=\"STANDARD\""fileDSK) (princ"\nF_=\"10\""fileDSK) (princ"\nAB=\"1.5\""fileDSK) (princ"\nZA=\"-10\""fileDSK) (princ"\nHP=\"0\""fileDSK) (princ"\nSP=\"0\""fileDSK) (princ"\nYVE=\"0\""fileDSK) (princ"\nWW=\"1,2,3,401,402,403\""fileDSK) (princ"\nMX=\"0\""fileDSK) (princ"\nMY=\"0\""fileDSK) (princ"\nMZ=\"0\""fileDSK) (princ"\nMXF=\"1\""fileDSK) (princ"\nMYF=\"1\""fileDSK) (princ"\nMZF=\"1\""fileDSK) ;** Fräsen Schlichten (princ"\n"fileDSK);** Leerzeile (princ"\n<105 \\Konturfraesen\\"fileDSK) (princ"\nEA=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ ":0\"" fileDSK) (princ"\nMDA=\"TAN\""fileDSK) (princ"\nRK=\"WRKL\""fileDSK) (princ"\nEE=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ "\:" fileDSK)(princ (if(lwpl-closed? polylinie) abschittsZahler (- abschittsZahler 1)) fileDSK)(princ "\"" fileDSK) (princ"\nMDE=\"TAN_AB\""fileDSK) (princ"\nEM=\"0\""fileDSK) (princ"\nRI=\"1\""fileDSK) (princ"\nTNO=\"102\""fileDSK) (princ"\nSM=\"0\""fileDSK) (princ"\nS_=\"STANDARD\""fileDSK) (princ"\nF_=\"7\""fileDSK) (princ"\nAB=\"0\""fileDSK) (princ"\nZA=\"-5\""fileDSK) (princ"\nHP=\"0\""fileDSK) (princ"\nSP=\"0\""fileDSK) (princ"\nYVE=\"0\""fileDSK) (princ"\nWW=\"1,2,3,401,402,403\""fileDSK) (princ"\nMX=\"0\""fileDSK) (princ"\nMY=\"0\""fileDSK) (princ"\nMZ=\"0\""fileDSK) (princ"\nMXF=\"1\""fileDSK) (princ"\nMYF=\"1\""fileDSK) (princ"\nMZF=\"1\""fileDSK) (setq anzbe (1+ anzbe)) );end foreach (close fileDSK) ); end DEFUN ;*********************************************************************************** ;**** schreibe - Runden **** ;*********************************************************************************** ; ;**** Function: (schreibe-Runden ) **** (defun schreibe-Runden (lwpl-daten datei-name / vertexListe ;** Liste mit nur den GC 10 und 42 anfangsPkt ;** erster Punkt der LW-Polylinie fileDSK ;** Handle der zu bearbeitenden Datei abschittsZahler U-BKS-X U-BKS-Y ) (setq fileDSK (open datei-name"a")) (if (not fileDSK) ((lambda() (alert(strcat"\n\nKann Datei :\""datei-name"\" nicht öffnen.\n")) (exit) )) );end if (foreach polylinie (mapcar'entget lwpl-daten) ;** Gruppen-Codes 10 und 42 raus-filtern (setq vertexListe (vl-remove-if-not '(lambda(einzelner-GC) (member (car einzelner-GC)'(10 42)) ); end LAMBDA polylinie ) anfangsPkt (cdr(assoc 10 vertexListe)) abschittsZahler 1 ); end SETQ (setq U-BKS-X (car (getvar "ucsorg"))) ;verschobenen X Ursprung BKS Merken (setq U-BKS-Y (cadr (getvar "ucsorg")));verschobenen Y Ursprung BKS Merken ;** der Anfangs-Punkt braucht Spezial-Behandlung (princ "\n\n]" fileDSK)(princ anzbe fileDSK) (princ "\n$E0" fileDSK) (princ "\nKP" fileDSK) (princ"\nX="fileDSK)(princ (rtos(-(car anfangsPkt)U-BKS-X)2 4) fileDSK) ;** X= (princ"\nY="fileDSK)(princ (rtos(-(cadr anfangsPkt)U-BKS-Y)2 4) fileDSK) ;** y= (princ"\nZ=0.0"fileDSK) ;** Z= (princ"\nKO=0" fileDSK) ;** KO=0 ;** In Schleifen einzelene Stützpunkte in MPR-Format bringen und in DATEI schreiben (while (< 2(length vertexListe));** Die besteht immer aus einer Folge ;** von Einträgen mit GC 10 gefolgt von einem Eintrag ;** mit GC 42. Deshalb kann nur ;** dann sinnvoll arbeiten, wenn noch DREI Werte ;** übergeben werden können. ;** WICHTIG: Es bleiben garantiert noch 2 Einträge in ;** der übrig. (verabeite-Vertex (cdar vertexListe);** Punkt1 (cdaddr vertexListe);** Punkt2 - GCs 10 und 42 wechseln sich ja ab .. (cdadr vertexListe);** BULGE fileDSK abschittsZahler ) (setq vertexListe (cddr vertexListe));** die beiden führenden Einträge sind schon verarbeitet (setq abschittsZahler (1+ abschittsZahler));** für den nächsten Abschnitt ); end WHILE:sollange noch Stützpunkte abzuarbeiten sind ;** Testen ob geschlossen ;** wenn geschlossen den Anfangs-Punkt nochmal ans Ende (if (lwpl-closed? polylinie) (verabeite-Vertex (cdar vertexListe);** Punkt1 anfangsPkt ;** Punkt2 - GCs 10 und 42 wechseln sich ja ab .. (cdadr vertexListe);** BULGE fileDSK abschittsZahler ;** stimmt schon, weil in der WHILE-Schleife hochgez. ) ); end IF: ist die LW-Polyline geschlossen?? ;** Fräsen Runden (princ"\n"fileDSK);** Leerzeile (princ"\n<105 \\Konturfraesen\\"fileDSK) (princ"\nEA=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ ":0\"" fileDSK) (princ"\nMDA=\"SEI\""fileDSK) (princ"\nRK=\"WRKL\""fileDSK) (princ"\nEE=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ "\:" fileDSK)(princ (if(lwpl-closed? polylinie) abschittsZahler (- abschittsZahler 1)) fileDSK)(princ "\"" fileDSK) (princ"\nMDE=\"SEI_AB\""fileDSK) (princ"\nEM=\"0\""fileDSK) (princ"\nRI=\"1\""fileDSK) (princ"\nTNO=\"805\""fileDSK) (princ"\nSM=\"0\""fileDSK) (princ"\nS_=\"STANDARD\""fileDSK) (princ"\nF_=\"5\""fileDSK) (princ"\nAB=\"0\""fileDSK) (princ"\nZA=\"0.5\""fileDSK) (princ"\nHP=\"0\""fileDSK) (princ"\nSP=\"0\""fileDSK) (princ"\nYVE=\"0\""fileDSK) (princ"\nWW=\"1,2,3,401,402,403\""fileDSK) (princ"\nMX=\"0\""fileDSK) (princ"\nMY=\"0\""fileDSK) (princ"\nMZ=\"0\""fileDSK) (princ"\nMXF=\"1\""fileDSK) (princ"\nMYF=\"1\""fileDSK) (princ"\nMZF=\"1\""fileDSK) (setq anzbe (1+ anzbe)) ) ;end foreach (close fileDSK) ); end DEFUN ;''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ;*********************************************************************************** ;**** schreibe - Runden Ablage **** ;*********************************************************************************** ; ;**** Function: (schreibe-Runden ) **** (defun schreibe-Runden-AB (lwpl-daten datei-name / vertexListe ;** Liste mit nur den GC 10 und 42 anfangsPkt ;** erster Punkt der LW-Polylinie fileDSK ;** Handle der zu bearbeitenden Datei abschittsZahler U-BKS-X U-BKS-Y ) (setq fileDSK (open datei-name"a")) (if (not fileDSK) ((lambda() (alert(strcat"\n\nKann Datei :\""datei-name"\" nicht öffnen.\n")) (exit) )) );end if (foreach polylinie (mapcar'entget lwpl-daten) ;** Gruppen-Codes 10 und 42 raus-filtern (setq vertexListe (vl-remove-if-not '(lambda(einzelner-GC) (member (car einzelner-GC)'(10 42)) ); end LAMBDA polylinie ) anfangsPkt (cdr(assoc 10 vertexListe)) abschittsZahler 1 ); end SETQ (setq U-BKS-X (car (getvar "ucsorg"))) ;verschobenen X Ursprung BKS Merken (setq U-BKS-Y (cadr (getvar "ucsorg")));verschobenen Y Ursprung BKS Merken ;** der Anfangs-Punkt braucht Spezial-Behandlung (princ "\n\n]" fileDSK)(princ anzbe fileDSK) (princ "\n$E0" fileDSK) (princ "\nKP" fileDSK) (princ"\nX="fileDSK)(princ (rtos(-(car anfangsPkt)U-BKS-X)2 4) fileDSK) ;** X= (princ"\nY="fileDSK)(princ (rtos(-(cadr anfangsPkt)U-BKS-Y)2 4) fileDSK) ;** y= (princ"\nZ=0.0"fileDSK) ;** Z= (princ"\nKO=0" fileDSK) ;** KO=0 ;** In Schleifen einzelene Stützpunkte in MPR-Format bringen und in DATEI schreiben (while (< 2(length vertexListe));** Die besteht immer aus einer Folge ;** von Einträgen mit GC 10 gefolgt von einem Eintrag ;** mit GC 42. Deshalb kann nur ;** dann sinnvoll arbeiten, wenn noch DREI Werte ;** übergeben werden können. ;** WICHTIG: Es bleiben garantiert noch 2 Einträge in ;** der übrig. (verabeite-Vertex (cdar vertexListe);** Punkt1 (cdaddr vertexListe);** Punkt2 - GCs 10 und 42 wechseln sich ja ab .. (cdadr vertexListe);** BULGE fileDSK abschittsZahler ) (setq vertexListe (cddr vertexListe));** die beiden führenden Einträge sind schon verarbeitet (setq abschittsZahler (1+ abschittsZahler));** für den nächsten Abschnitt ); end WHILE:sollange noch Stützpunkte abzuarbeiten sind ;** Testen ob geschlossen ;** wenn geschlossen den Anfangs-Punkt nochmal ans Ende (if (lwpl-closed? polylinie) (verabeite-Vertex (cdar vertexListe);** Punkt1 anfangsPkt ;** Punkt2 - GCs 10 und 42 wechseln sich ja ab .. (cdadr vertexListe);** BULGE fileDSK abschittsZahler ;** stimmt schon, weil in der WHILE-Schleife hochgez. ) ); end IF: ist die LW-Polyline geschlossen?? ;** Fräsen Runden (princ"\n"fileDSK);** Leerzeile (princ"\n<105 \\Konturfraesen\\"fileDSK) (princ"\nEA=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ ":0\"" fileDSK) (princ"\nMDA=\"SEI\""fileDSK) (princ"\nRK=\"WRKL\""fileDSK) (princ"\nEE=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ "\:" fileDSK)(princ (if(lwpl-closed? polylinie) abschittsZahler (- abschittsZahler 1)) fileDSK)(princ "\"" fileDSK) (princ"\nMDE=\"SEI_AB\""fileDSK) (princ"\nEM=\"0\""fileDSK) (princ"\nRI=\"1\""fileDSK) (princ"\nTNO=\"806\""fileDSK) (princ"\nSM=\"0\""fileDSK) (princ"\nS_=\"STANDARD\""fileDSK) (princ"\nF_=\"5\""fileDSK) (princ"\nAB=\"0\""fileDSK) (princ"\nZA=\"D/2\""fileDSK) (princ"\nHP=\"0\""fileDSK) (princ"\nSP=\"0\""fileDSK) (princ"\nYVE=\"0\""fileDSK) (princ"\nWW=\"1,2,3,401,402,403\""fileDSK) (princ"\nMX=\"0\""fileDSK) (princ"\nMY=\"0\""fileDSK) (princ"\nMZ=\"0\""fileDSK) (princ"\nMXF=\"1\""fileDSK) (princ"\nMYF=\"1\""fileDSK) (princ"\nMZF=\"1\""fileDSK) (setq anzbe (1+ anzbe)) ) ;end foreach (close fileDSK) ); end DEFUN ;************************************************************************************************************************************************* ;*********************************************************************************** ;**** schreibe - Schleifen **** ;*********************************************************************************** ; ;**** Function: (schreibe-Runden ) **** (defun schreibe-schleifen (lwpl-daten datei-name / vertexListe ;** Liste mit nur den GC 10 und 42 anfangsPkt ;** erster Punkt der LW-Polylinie fileDSK ;** Handle der zu bearbeitenden Datei abschittsZahler U-BKS-X U-BKS-Y ) (setq fileDSK (open datei-name"a")) (if (not fileDSK) ((lambda() (alert(strcat"\n\nKann Datei :\""datei-name"\" nicht öffnen.\n")) (exit) )) );end if (foreach polylinie (mapcar'entget lwpl-daten) ;** Gruppen-Codes 10 und 42 raus-filtern (setq vertexListe (vl-remove-if-not '(lambda(einzelner-GC) (member (car einzelner-GC)'(10 42)) ); end LAMBDA polylinie ) anfangsPkt (cdr(assoc 10 vertexListe)) abschittsZahler 1 ); end SETQ (setq U-BKS-X (car (getvar "ucsorg"))) ;verschobenen X Ursprung BKS Merken (setq U-BKS-Y (cadr (getvar "ucsorg")));verschobenen Y Ursprung BKS Merken ;** der Anfangs-Punkt braucht Spezial-Behandlung (princ "\n\n]" fileDSK)(princ anzbe fileDSK) (princ "\n$E0" fileDSK) (princ "\nKP" fileDSK) (princ"\nX="fileDSK)(princ (rtos(-(car anfangsPkt)U-BKS-X)2 4) fileDSK) ;** X= (princ"\nY="fileDSK)(princ (rtos(-(cadr anfangsPkt)U-BKS-Y)2 4) fileDSK) ;** y= (princ"\nZ=0.0"fileDSK) ;** Z= (princ"\nKO=0" fileDSK) ;** KO=0 ;** In Schleifen einzelene Stützpunkte in MPR-Format bringen und in DATEI schreiben (while (< 2(length vertexListe));** Die besteht immer aus einer Folge ;** von Einträgen mit GC 10 gefolgt von einem Eintrag ;** mit GC 42. Deshalb kann nur ;** dann sinnvoll arbeiten, wenn noch DREI Werte ;** übergeben werden können. ;** WICHTIG: Es bleiben garantiert noch 2 Einträge in ;** der übrig. (verabeite-Vertex (cdar vertexListe);** Punkt1 (cdaddr vertexListe);** Punkt2 - GCs 10 und 42 wechseln sich ja ab .. (cdadr vertexListe);** BULGE fileDSK abschittsZahler ) (setq vertexListe (cddr vertexListe));** die beiden führenden Einträge sind schon verarbeitet (setq abschittsZahler (1+ abschittsZahler));** für den nächsten Abschnitt ); end WHILE:sollange noch Stützpunkte abzuarbeiten sind ;** Testen ob geschlossen ;** wenn geschlossen den Anfangs-Punkt nochmal ans Ende (if (lwpl-closed? polylinie) (verabeite-Vertex (cdar vertexListe);** Punkt1 anfangsPkt ;** Punkt2 - GCs 10 und 42 wechseln sich ja ab .. (cdadr vertexListe);** BULGE fileDSK abschittsZahler ;** stimmt schon, weil in der WHILE-Schleife hochgez. ) ); end IF: ist die LW-Polyline geschlossen?? ;** Fräsen Schleifen (princ"\n"fileDSK);** Leerzeile (princ"\n<105 \\Konturfraesen\\"fileDSK) (princ"\nEA=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ ":0\"" fileDSK) (princ"\nMDA=\"SEI\""fileDSK) (princ"\nRK=\"WRKL\""fileDSK) (princ"\nEE=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ "\:" fileDSK)(princ (if(lwpl-closed? polylinie) abschittsZahler (- abschittsZahler 1)) fileDSK)(princ "\"" fileDSK) (princ"\nMDE=\"SEI_AB\""fileDSK) (princ"\nEM=\"0\""fileDSK) (princ"\nRI=\"1\""fileDSK) (princ"\nTNO=\"810\""fileDSK) (princ"\nSM=\"0\""fileDSK) (princ"\nS_=\"STANDARD\""fileDSK) (princ"\nF_=\"5\""fileDSK) (princ"\nAB=\"-0.1\""fileDSK) (princ"\nZA=\"0.5\""fileDSK) (princ"\nHP=\"0\""fileDSK) (princ"\nSP=\"0\""fileDSK) (princ"\nYVE=\"0\""fileDSK) (princ"\nWW=\"1,2,3,401,402,403\""fileDSK) (princ"\nMX=\"0\""fileDSK) (princ"\nMY=\"0\""fileDSK) (princ"\nMZ=\"0\""fileDSK) (princ"\nMXF=\"1\""fileDSK) (princ"\nMYF=\"1\""fileDSK) (princ"\nMZF=\"1\""fileDSK) ;** Fräsen Schleifen (princ"\n"fileDSK);** Leerzeile (princ"\n<105 \\Konturfraesen\\"fileDSK) (princ"\nEA=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ ":0\"" fileDSK) (princ"\nMDA=\"SEI\""fileDSK) (princ"\nRK=\"WRKL\""fileDSK) (princ"\nEE=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ "\:" fileDSK)(princ (if(lwpl-closed? polylinie) abschittsZahler (- abschittsZahler 1)) fileDSK)(princ "\"" fileDSK) (princ"\nMDE=\"SEI_AB\""fileDSK) (princ"\nEM=\"0\""fileDSK) (princ"\nRI=\"1\""fileDSK) (princ"\nTNO=\"810\""fileDSK) (princ"\nSM=\"0\""fileDSK) (princ"\nS_=\"STANDARD\""fileDSK) (princ"\nF_=\"5\""fileDSK) (princ"\nAB=\"-0.2\""fileDSK) (princ"\nZA=\"0.5\""fileDSK) (princ"\nHP=\"0\""fileDSK) (princ"\nSP=\"0\""fileDSK) (princ"\nYVE=\"0\""fileDSK) (princ"\nWW=\"1,2,3,401,402,403\""fileDSK) (princ"\nMX=\"0\""fileDSK) (princ"\nMY=\"0\""fileDSK) (princ"\nMZ=\"0\""fileDSK) (princ"\nMXF=\"1\""fileDSK) (princ"\nMYF=\"1\""fileDSK) (princ"\nMZF=\"1\""fileDSK) ;** Fräsen Schleifen (princ"\n"fileDSK);** Leerzeile (princ"\n<105 \\Konturfraesen\\"fileDSK) (princ"\nEA=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ ":0\"" fileDSK) (princ"\nMDA=\"SEI\""fileDSK) (princ"\nRK=\"WRKL\""fileDSK) (princ"\nEE=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ "\:" fileDSK)(princ (if(lwpl-closed? polylinie) abschittsZahler (- abschittsZahler 1)) fileDSK)(princ "\"" fileDSK) (princ"\nMDE=\"SEI_AB\""fileDSK) (princ"\nEM=\"0\""fileDSK) (princ"\nRI=\"1\""fileDSK) (princ"\nTNO=\"810\""fileDSK) (princ"\nSM=\"0\""fileDSK) (princ"\nS_=\"STANDARD\""fileDSK) (princ"\nF_=\"5\""fileDSK) (princ"\nAB=\"-0.3\""fileDSK) (princ"\nZA=\"0.5\""fileDSK) (princ"\nHP=\"0\""fileDSK) (princ"\nSP=\"0\""fileDSK) (princ"\nYVE=\"0\""fileDSK) (princ"\nWW=\"1,2,3,401,402,403\""fileDSK) (princ"\nMX=\"0\""fileDSK) (princ"\nMY=\"0\""fileDSK) (princ"\nMZ=\"0\""fileDSK) (princ"\nMXF=\"1\""fileDSK) (princ"\nMYF=\"1\""fileDSK) (princ"\nMZF=\"1\""fileDSK) (setq anzbe (1+ anzbe)) ) ;end foreach (close fileDSK) ); end DEFUN ;*********************************************************************************** ;**** schreibe - nur Kontur **** ;*********************************************************************************** ; ;**** Function: (schreibe-Runden ) **** (defun schreibe-Kontur (lwpl-daten datei-name / vertexListe ;** Liste mit nur den GC 10 und 42 anfangsPkt ;** erster Punkt der LW-Polylinie fileDSK ;** Handle der zu bearbeitenden Datei abschittsZahler U-BKS-X U-BKS-Y ) (setq fileDSK (open datei-name"a")) (if (not fileDSK) ((lambda() (alert(strcat"\n\nKann Datei :\""datei-name"\" nicht öffnen.\n")) (exit) )) );end if (foreach polylinie (mapcar'entget lwpl-daten) ;** Gruppen-Codes 10 und 42 raus-filtern (setq vertexListe (vl-remove-if-not '(lambda(einzelner-GC) (member (car einzelner-GC)'(10 42)) ); end LAMBDA polylinie ) anfangsPkt (cdr(assoc 10 vertexListe)) abschittsZahler 1 ); end SETQ (setq U-BKS-X (car (getvar "ucsorg"))) ;verschobenen X Ursprung BKS Merken (setq U-BKS-Y (cadr (getvar "ucsorg")));verschobenen Y Ursprung BKS Merken ;** der Anfangs-Punkt braucht Spezial-Behandlung (princ "\n\n]" fileDSK)(princ anzbe fileDSK) (princ "\n$E0" fileDSK) (princ "\nKP" fileDSK) (princ"\nX="fileDSK)(princ (rtos(-(car anfangsPkt)U-BKS-X)2 4) fileDSK) ;** X= (princ"\nY="fileDSK)(princ (rtos(-(cadr anfangsPkt)U-BKS-Y)2 4) fileDSK) ;** y= (princ"\nZ=0.0"fileDSK) ;** Z= (princ"\nKO=0" fileDSK) ;** KO=0 ;** In Schleifen einzelene Stützpunkte in MPR-Format bringen und in DATEI schreiben (while (< 2(length vertexListe));** Die besteht immer aus einer Folge ;** von Einträgen mit GC 10 gefolgt von einem Eintrag ;** mit GC 42. Deshalb kann nur ;** dann sinnvoll arbeiten, wenn noch DREI Werte ;** übergeben werden können. ;** WICHTIG: Es bleiben garantiert noch 2 Einträge in ;** der übrig. (verabeite-Vertex (cdar vertexListe);** Punkt1 (cdaddr vertexListe);** Punkt2 - GCs 10 und 42 wechseln sich ja ab .. (cdadr vertexListe);** BULGE fileDSK abschittsZahler ) (setq vertexListe (cddr vertexListe));** die beiden führenden Einträge sind schon verarbeitet (setq abschittsZahler (1+ abschittsZahler));** für den nächsten Abschnitt ); end WHILE:sollange noch Stützpunkte abzuarbeiten sind ;** Testen ob geschlossen ;** wenn geschlossen den Anfangs-Punkt nochmal ans Ende (if (lwpl-closed? polylinie) (verabeite-Vertex (cdar vertexListe);** Punkt1 anfangsPkt ;** Punkt2 - GCs 10 und 42 wechseln sich ja ab .. (cdadr vertexListe);** BULGE fileDSK abschittsZahler ;** stimmt schon, weil in der WHILE-Schleife hochgez. ) ); end IF: ist die LW-Polyline geschlossen?? ) ;end foreach (close fileDSK) ); end DEFUN ;*********************************************************************************** ;**** schreibe-bohrungen **** ;*********************************************************************************** ; (defun schreibe-bohrungen (kreis-liste datei-name / radius mitte ;** Kreis-mittel-Punkte fileDSK U-BKS-X;verschobenen X Ursprung BKS Merken U-BKS-Y ) (setq fileDSK (open datei-name"a")) (if (not fileDSK) ((lambda() (alert(strcat"\n\nKann Datei :\""datei-name"\" nicht öffnen.\n")) (exit) )) );end if (setq U-BKS-X (car (getvar "ucsorg"))) ;verschobenen X Ursprung BKS Merken (setq U-BKS-Y (cadr (getvar "ucsorg")));verschobenen Y Ursprung BKS Merken (foreach kreis (mapcar'entget kreis-liste) (setq mitte (cdr(assoc 10 kreis)) radius (cdr(assoc 40 kreis)) ); end SETQ (princ"\n"fileDSK);** Leerzeile (princ"\n<102 \\BohrVert\\"fileDSK) (princ"\nXA="fileDSK)(prin1(rtos(-(car mitte)U-BKS-X)2 4) fileDSK) (princ"\nYA="fileDSK)(prin1(rtos(-(cadr mitte)U-BKS-Y)2 4) fileDSK) (princ"\nBM=\"LS\""fileDSK) (princ"\nTI=\"14\""fileDSK) (princ"\nDU="fileDSK)(prin1(rtos(* 2 radius)2 4) fileDSK) (princ"\nAN=\"1\""fileDSK) (princ"\nMI=\"0\""fileDSK) (princ"\nS_=\"2\""fileDSK) (princ"\nAB=\"32\""fileDSK) (princ"\nWI=\"0\""fileDSK) (princ"\nHP=\"0\""fileDSK) (princ"\nSP=\"0\""fileDSK) (princ"\nYVE=\"0\""fileDSK) (princ"\nWW=\"60,61,62,88,90,91,92,150\""fileDSK) (princ"\nMX=\"0\""fileDSK) (princ"\nMY=\"0\""fileDSK) (princ"\nMZ=\"0\""fileDSK) (princ"\nMXF=\"1\""fileDSK) (princ"\nMYF=\"1\""fileDSK) (princ"\nMZF=\"1\""fileDSK) ); end FOREACH (close fileDSK) ); end DEFUN ; ;*********************************************************************************** ;**** verabeite-Vertex **** ;*********************************************************************************** ; (defun verabeite-Vertex (punkt1 punkt2 bulge fileDSK n / U-BKS-X U-BKS-Y ) (setq U-BKS-X (car (getvar "ucsorg"))) ;verschobenen X Ursprung BKS Merken (setq U-BKS-Y (cadr (getvar "ucsorg")));verschobenen Y Ursprung BKS Merken (princ"\n"fileDSK);** Leerzeile (princ"\n$E"fileDSK)(princ n fileDSK);** $E - Abschnitts-Marke ;** Testen ob Bogen oder Linie (cond ;** LINIE ((= 0 bulge) (princ"\nKL"fileDSK);++ KL (princ"\nX="fileDSK)(princ (rtos(-(car punkt2)U-BKS-X)2 4) fileDSK);++ X= (princ"\nY="fileDSK)(princ (rtos(-(cadr punkt2)U-BKS-Y)2 4) fileDSK);++ Y= ); end Alt0: ein Linien-Segment ;** BOGEN ('dann-bleibt-nur-noch-ein-BOGEN-uebrig (princ"\nKA"fileDSK);++ KA (princ"\nX="fileDSK)(princ (rtos(-(car punkt2)U-BKS-X)2 4 ) fileDSK);++ X= (princ"\nY="fileDSK)(princ (rtos(-(cadr punkt2)U-BKS-Y)2 4 ) fileDSK);++ Y= ;@@ TODO: hier muss geprüft werden, wie die NC-Steuerung auf @@ ;@@ Winkel-Vorgaben reagiert, die aus Vertices resultieren, @@ ;@@ die mehr als Halbkreise beschreiben!! @@ (princ"\nDS="fileDSK) ;++ DS= (princ (ermittle-drehrichtungs-grosse punkt1 punkt2 bulge) fileDSK) (princ"\nR="fileDSK) ;++ R= (princ (lwpl-radius punkt1 punkt2 bulge) fileDSK) ); end Alt0: ein Linien-Segment ); end COND ); end DEFUN ; ;*********************************************************************************** ;**** ermittle-drehrichtungs-grosse **** ;*********************************************************************************** ; (defun ermittle-drehrichtungs-grosse (p1 p2 ausbuchtung) ;@@ BETA - BETA @@ (if (< 0 ausbuchtung) 1;** MPR-Wert für Links-Drehung 0;** MPR-Wert für Rechts-Drehung ) ); end DEFUN ; ;*********************************************************************************** ;**** finde-bohrungsKreise **** ;*********************************************************************************** ; (defun finde-bohrungsKreise ( / aws ;** Auswahl-Satz der Kreise cnt ;** Zähler kreis-liste ;** Liste mit Kreis-ENAMES ) (Princ"\nBohrungen (Kreise) wählen >") (setq aws (ssget'((0 . "CIRCLE")(8 . "Bohrung")))) (setq cnt 0) (if aws (repeat (sslength aws) (setq kreis-liste (cons (ssname aws cnt) kreis-liste) cnt (1+ cnt) ) ); end repeat ); end IF:Was gefunden kreis-liste ); end DEFUN ; ;----------------------------------------------------------- ;---- ---- ;---- Funktionen mit allgemeinem Wert ---- ;---- ---- ;----------------------------------------------------------- ; ;*********************************************************************************** ;**** lwpl-closed? **** ;*********************************************************************************** ; ;**** Function (lwpl-closed? ) **** (defun lwpl-closed? (lwpl) (cond ((='polylinie(TYPE lwpl)) (= 1(cdr(assoc 70(entget lwpl)))) ); end Alt0:ENAME?? ((='LIST(type lwpl)) ;@@@ das muss auf Entity-Daten-Listen erweitert werden @@@ (= 1(cdr(assoc 70 lwpl))) ) ) ); end DEFUN ; ;*********************************************************************************** ;**** lwpl-radius **** ;*********************************************************************************** ; (defun lwpl-radius (p1 p2 b / winkel radius) ;@@ OHNE FEHLER-KORREKTUR - FEHLT noch @@ (setq winkel (* 4(atan b))) (setq radius (/ (vektor-laenge (vektor-minus p1 p2)) (* 2 (sin(* 0.5 winkel))) ) ); end SETQ ); end DEFUN ; ;*********************************************************************************** ;**** vektor-minus **** ;*********************************************************************************** ; (defun vektor-minus (x y) (mapcar'- x y) ); end ; ;*********************************************************************************** ;**** vektor-laenge **** ;*********************************************************************************** ; (defun vektor-laenge (x) (sqrt (apply'+ (mapcar'* x x) ) ) ); end ;*********************************************************************************** ; (schreibe-Werkstuck dwgn) ;*********************************************************************************** (defun schreibe-Werkstuck (dwgName / fileDSK) (setq fileDSK (open dwgName "a")) (princ"\n"fileDSK);** Leerzeile (princ "\n<100 \\WerkStck\\"fileDSK) (princ "\nLA=" fileDSK)(prin1 "L" fileDSK) (princ "\nBR=" fileDSK)(prin1 "B" fileDSK) (princ "\nDI=" fileDSK)(prin1 "D" fileDSK) (princ "\nFNX=" fileDSK)(prin1 "3" fileDSK) (princ "\nFNY=" fileDSK)(prin1 "3" fileDSK) (princ "\nRNX=" fileDSK)(prin1 "0" fileDSK) (princ "\nRNY=" fileDSK)(prin1 "0" fileDSK) (princ "\nRNZ=" fileDSK)(prin1 "0" fileDSK) (princ "\nAX=" fileDSK)(prin1 "6" fileDSK) (princ "\nAY=" fileDSK)(prin1 "6" fileDSK) (close fileDSK) );end defun ; (schreibe-MPR-Abschluss dwgn) (defun schreibe-MPR-Abschluss (dwgName / fileDSK) (setq fileDSK (open dwgName "a")) (princ"\n!"fileDSK);** Schulßzeichen WOODWOP 4.5 (close fileDSK) ) ;*********************************************************************************** ;**** schreibe-Kreistaschen **** ;*********************************************************************************** ; (defun schreibe-kreistaschen (kreis-liste datei-name / radius mitte ;** Kreis-mittel-Punkte fileDSK U-BKS-X U-BKS-Y ) (setq fileDSK (open datei-name"a")) (if (not fileDSK) ((lambda() (alert(strcat"\n\nKann Datei :\""datei-name"\" nicht öffnen.\n")) (exit) )) ) (setq U-BKS-X (car (getvar "ucsorg"))) ;verschobenen X Ursprung BKS Merken (setq U-BKS-Y (cadr (getvar "ucsorg")));verschobenen Y Ursprung BKS Merken (foreach kreis (mapcar'entget kreis-liste) (setq mitte (cdr(assoc 10 kreis)) radius (cdr(assoc 40 kreis)) ); end SETQ ;Schruppen (princ"\n"fileDSK);** Leerzeile (princ"\n<112 \\Tasche\\"fileDSK) (princ"\nXA="fileDSK)(prin1 (rtos(-(car mitte)U-BKS-X)2 4) fileDSK) (princ"\nYA="fileDSK)(prin1 (rtos(-(cadr mitte)U-BKS-Y)2 4) fileDSK) (princ"\nLA=\"0\""fileDSK) (princ"\nBR=\"0\""fileDSK) (princ"\nRD="fileDSK)(princ "\"" fileDSK)(prin1 (+ radius 0.3) fileDSK)(princ "\"" fileDSK) (princ"\nWI=\"0\""fileDSK) (princ"\nTI=\"23\""fileDSK) (princ"\nZT=\"0\""fileDSK) (princ"\nXZ=\"80\""fileDSK) (princ"\nT_=\"801\""fileDSK) (princ"\nF_=\"5\""fileDSK) (princ"\nDS=\"0\""fileDSK) (princ"\nHP=\"0\""fileDSK) (princ"\nSP=\"0\""fileDSK) (princ"\nYVE=\"0\""fileDSK) (princ"\nWW=\"1,2,3,401,402,403\""fileDSK) (princ"\nMX=\"0\""fileDSK) (princ"\nMY=\"0\""fileDSK) (princ"\nMZ=\"0\""fileDSK) (princ"\nMXF=\"1\""fileDSK) (princ"\nMYF=\"1\""fileDSK) (princ"\nMZF=\"1\""fileDSK) (princ"\nKO=\"00\""fileDSK) ); end FOREACH (close fileDSK) ); end DEFUN ; ;*********************************************************************************** ;**** finde-Kreistaschen **** ;*********************************************************************************** ; (defun finde-Tasche ( / aws ;** Auswahl-Satz der Kreise cnt ;** Zähler kreis-liste ;** Liste mit Kreis-ENAMES ) (Princ"\nKreistaschen **Verbinder** (Kreise) wählen >") (setq aws (ssget'((0 . "CIRCLE")(8 . "Verbinder")))) (setq cnt 0) (if aws (repeat (sslength aws) (setq kreis-liste (cons (ssname aws cnt) kreis-liste) cnt (1+ cnt) ) ); end repeat ); end IF:Was gefunden kreis-liste ); end DEFUN ;*********************************************************************************** ;**** finde-Verbinder Linien **** ;*********************************************************************************** ; (defun finde-line ( / aws ;** Auswahl-Satz der Linien cnt ;** Zähler line-liste ;** Liste mit Kreis-ENAMES ) (Princ"\nVerbinder (Linien) wählen >") (setq aws (ssget'((0 . "LINE")(8 . "Verbinder")))) (setq cnt 0) (if aws (repeat (sslength aws) (setq line-liste (cons (ssname aws cnt) line-liste) cnt (1+ cnt) ) ); end repeat ); end IF:Was gefunden line-liste ); end DEFUN ;*********************************************************************************** ;**** schreibe-Linien **** ;*********************************************************************************** ; (defun schreibe-Line (line-liste datei-name / APK ;Anfangspunkt EPK ;** Endpunkt fileDSK U-BKS-X U-BKS-Y ) (setq fileDSK (open datei-name "a")) (if (not fileDSK) ((lambda() (alert(strcat"\n\nKann Datei :\""datei-name"\" nicht öffnen.\n")) (exit) )) ) (setq U-BKS-X (car (getvar "ucsorg"))) (setq U-BKS-Y (cadr (getvar "ucsorg"))) (foreach line (mapcar'entget line-liste) (setq APK (cdr(assoc 10 line)) EPK (cdr(assoc 11 line)) ); end SETQ ;** Fräsen (princ"\n"fileDSK);** Leerzeile (princ"\n<105 \\Konturfraesen\\"fileDSK) (princ"\nEA=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ ":0\"" fileDSK) (princ"\nMDA=\"SEN\""fileDSK) (princ"\nRK=\"NoWRK\""fileDSK) ;(princ"\nRD="fileDSK)(prin1(rtos radius 2 4)fileDSK) (princ"\nEE=" fileDSK)(princ "\"" fileDSK)(princ anzbe fileDSK)(princ ":1\"" fileDSK) (princ"\nMDE=\"SEN_AB\""fileDSK) (princ"\nEM=\"0\""fileDSK) (princ"\nRI=\"1\""fileDSK) (princ"\nTNO=\"801\""fileDSK) (princ"\nSM=\"0\""fileDSK) (princ"\nS_=\"STANDARD\""fileDSK) (princ"\nF_=\"5\""fileDSK) (princ"\nAB=\"0\""fileDSK) (princ"\nZA=\"17\""fileDSK) (princ"\nHP=\"0\""fileDSK) (princ"\nSP=\"0\""fileDSK) (princ"\nYVE=\"0\""fileDSK) (princ"\nWW=\"1,2,3,401,402,403\""fileDSK) (princ"\nMX=\"0\""fileDSK) (princ"\nMY=\"0\""fileDSK) (princ"\nMZ=\"0\""fileDSK) (princ"\nMXF=\"1\""fileDSK) (princ"\nMYF=\"1\""fileDSK) (princ"\nMZF=\"1\""fileDSK) ;** Punkt (princ "\n\n]"fileDSK)(princ anzbe fileDSK) (princ"\n$E"fileDSK)(princ 0 fileDSK);** $E - Abschnitts-Marke (princ"\nKP"fileDSK);++ KP (princ"\nX="fileDSK)(princ (rtos (-(car APK)U-BKS-X)2 4) fileDSK) ;** X= (princ"\nY="fileDSK)(princ (rtos (-(cadr APK)U-BKS-Y)2 4) fileDSK) ;** y= (princ"\nZ=0.0"fileDSK) ;** Z= (princ"\nKO=0" fileDSK) ;** LINIE (princ"\n\n$E"fileDSK)(princ 1 fileDSK) (princ"\nKL"fileDSK);++ KL (princ"\nX="fileDSK)(princ (rtos(-(car EPK)U-BKS-X)2 4) fileDSK);++ X= (princ"\nY="fileDSK)(princ (rtos(-(cadr EPK)U-BKS-Y)2 4) fileDSK);++ Y= (setq anzbe (1+ anzbe)) ); end FOREACH (close fileDSK) ); end DEFUN ; ;*********************************************************************************** ;**** schreibe-Kreistaschen durch **** ;*********************************************************************************** ; (defun schreibe-kreistaschen2 (kreis-liste datei-name / radius mitte ;** Kreis-mittel-Punkte fileDSK U-BKS-X U-BKS-Y ) (setq fileDSK (open datei-name"a")) (if (not fileDSK) ((lambda() (alert(strcat"\n\nKann Datei :\""datei-name"\" nicht öffnen.\n")) (exit) )) ) (setq U-BKS-X (car (getvar "ucsorg"))) ;verschobenen X Ursprung BKS Merken (setq U-BKS-Y (cadr (getvar "ucsorg")));verschobenen Y Ursprung BKS Merken (foreach kreis (mapcar'entget kreis-liste) (setq mitte (cdr(assoc 10 kreis)) radius (cdr(assoc 40 kreis)) ); end SETQ ;Schruppen (princ"\n"fileDSK);** Leerzeile (princ"\n<112 \\Tasche\\"fileDSK) (princ"\nXA="fileDSK)(prin1 (rtos(-(car mitte)U-BKS-X)2 4) fileDSK) (princ"\nYA="fileDSK)(prin1 (rtos(-(cadr mitte)U-BKS-Y)2 4) fileDSK) (princ"\nLA=\"0\""fileDSK) (princ"\nBR=\"0\""fileDSK) (princ"\nRD="fileDSK)(princ "\"" fileDSK)(prin1 (+ radius 0.4) fileDSK)(princ "\"" fileDSK) (princ"\nWI=\"0\""fileDSK) (princ"\nTI=\"44\""fileDSK) (princ"\nZT=\"0\""fileDSK) (princ"\nXZ=\"80\""fileDSK) (princ"\nT_=\"104\""fileDSK) (princ"\nF_=\"4\""fileDSK) (princ"\nDS=\"0\""fileDSK) (princ"\nHP=\"0\""fileDSK) (princ"\nSP=\"0\""fileDSK) (princ"\nYVE=\"0\""fileDSK) (princ"\nWW=\"1,2,3,401,402,403\""fileDSK) (princ"\nMX=\"0\""fileDSK) (princ"\nMY=\"0\""fileDSK) (princ"\nMZ=\"0\""fileDSK) (princ"\nMXF=\"1\""fileDSK) (princ"\nMYF=\"1\""fileDSK) (princ"\nMZF=\"1\""fileDSK) (princ"\nKO=\"00\""fileDSK) ); end FOREACH (close fileDSK) ); end DEFUN ;*********************************************************************************** ;**** finde-Kreistaschen durchgehend **** ;*********************************************************************************** ; (defun finde-Tasche2 ( / aws ;** Auswahl-Satz der Kreise cnt ;** Zähler kreis-liste ;** Liste mit Kreis-ENAMES ) (Princ"\n Kreistaschen durchgehend (Kreise) wählen >") (setq aws (ssget'((0 . "CIRCLE")(8 . "Kreistasche_durch")))) (setq cnt 0) (if aws (repeat (sslength aws) (setq kreis-liste (cons (ssname aws cnt) kreis-liste) cnt (1+ cnt) ) ); end repeat ); end IF:Was gefunden kreis-liste ); end DEFUN ;*********************************************************************************** ;**** finde - mehrere Polylinien (fräsen) **** ;*********************************************************************************** ; (defun finde-LWPL ( / aws ;** Auswahl-Satz der Kreise cnt ;** Zähler PL-liste ;** Liste mit Kreis-ENAMES ) (Princ"\n Fräskonturen Schruppen und Schlichten (Polylinien) wählen >") (setq aws (ssget'((0 . "LWPOLYLINE")(8 . "Fräsen")))) (setq cnt 0) (if aws (repeat (sslength aws) (setq PL-liste (cons (ssname aws cnt) PL-liste) cnt (1+ cnt) ) ); end repeat ); end IF:Was gefunden PL-liste ); end DEFUN ;*********************************************************************************** ;**** finde - mehrere Polylinien (Runden) **** ;*********************************************************************************** ; (defun finde-runden ( / aws ;** Auswahl-Satz der Kreise cnt ;** Zähler PL-liste ;** Liste mit Kreis-ENAMES ) (Princ"\n Fräskonturen Runden (Polylinien) wählen >") (setq aws (ssget'((0 . "LWPOLYLINE")(8 . "Runden")))) (setq cnt 0) (if aws (repeat (sslength aws) (setq PL-liste (cons (ssname aws cnt) PL-liste) cnt (1+ cnt) ) ); end repeat ); end IF:Was gefunden PL-liste ); end DEFUN ;*********************************************************************************** ;**** finde - mehrere Polylinien (Runden Ablage) **** ;*********************************************************************************** ; (defun finde-runden-AB ( / aws ;** Auswahl-Satz der Kreise cnt ;** Zähler PL-liste ;** Liste mit Kreis-ENAMES ) (Princ"\n Fräskonturen **** RUNDEN ABLAGE **** (Polylinien) wählen >") (setq aws (ssget'((0 . "LWPOLYLINE")(8 . "Runden-AB")))) (setq cnt 0) (if aws (repeat (sslength aws) (setq PL-liste (cons (ssname aws cnt) PL-liste) cnt (1+ cnt) ) ); end repeat ); end IF:Was gefunden PL-liste ); end DEFUN ;*********************************************************************************** ;**** finde - mehrere Polylinien (Schleifen) **** ;*********************************************************************************** ; (defun finde-schleifen ( / aws ;** Auswahl-Satz der Kreise cnt ;** Zähler PL-liste ;** Liste mit Kreis-ENAMES ) (Princ"\n Fräskonturen Schleifen (Polylinien) wählen >") (setq aws (ssget'((0 . "LWPOLYLINE")(8 . "Schleifen")))) (setq cnt 0) (if aws (repeat (sslength aws) (setq PL-liste (cons (ssname aws cnt) PL-liste) cnt (1+ cnt) ) ); end repeat ); end IF:Was gefunden PL-liste ); end DEFUN ;*********************************************************************************** ;**** finde - mehrere Polylinien (nur Kontur) **** ;*********************************************************************************** ; (defun finde-Kontur ( / aws ;** Auswahl-Satz der Kreise cnt ;** Zähler PL-liste ;** Liste mit Kreis-ENAMES ) (Princ"\n Fräskonturen Kontur (Polylinien Layer Kontur) wählen >") (setq aws (ssget'((0 . "LWPOLYLINE")(8 . "Kontur")))) (setq cnt 0) (if aws (repeat (sslength aws) (setq PL-liste (cons (ssname aws cnt) PL-liste) cnt (1+ cnt) ) ); end repeat ); end IF:Was gefunden PL-liste ); end DEFUN ;*********************************************************************************** ;**** Breite und Länge zeigen **** ;*********************************************************************************** ; (defun Laenge-Breite-zeigen ( / ;P1 P2 liste ) (setq P1 (getpoint " \n Von Null aus, Zweiter Punkt für **LÄNGE** des Werkstück's in X-Richtung" )) (setq P2 (getpoint " \n Von Null aus, Zweiter Punkt für **Breite** des Werkstück's in Y-Richtung" )) (setq liste (list (car p1) (cadr p2) )) liste );end Defun ;*********************************************************************************** ;**** finde - Text (Mtext) **** ;*********************************************************************************** ; (defun finde-text ( / aws ;** Auswahl-Satz der Texte cnt ;** Zähler PL-liste ;** Liste mit Text-ENAMES ) (Princ"\n < Kommentar (nur Dtext) wählen >") (setq aws (ssget'((0 . "TEXT")(8 . "Text")))) (setq cnt 0) (if aws (repeat (sslength aws) (setq PL-liste (cons (ssname aws cnt) PL-liste) cnt (1+ cnt) ) ); end repeat ); end IF:Was gefunden PL-liste ); end DEFUN ;*********************************************************************************** ;**** schreibe-Text (Kommentar) **** ;*********************************************************************************** ; (defun schreibe-text (text-liste datei-name / mtext fileDSK ) (setq fileDSK (open datei-name"a")) (if (not fileDSK) ((lambda() (alert(strcat"\n\nKann Datei :\""datei-name"\" nicht öffnen.\n")) (exit) )) );end if (princ"\n"fileDSK);** Leerzeile ; (schreibe-kommentar dwgn) (princ "\n<101 \\Kommentar\\"fileDSK) (princ "\nKM=" fileDSK)(prin1 "Generiert direkt aus AutoCAD" fileDSK) (princ "\nKM=" fileDSK)(prin1 "Achtung: alle Bohrungen 14 mm tief" fileDSK) (princ "\nKM=" fileDSK)(prin1 "Achtung: alle Taschen Fräserauswahl beachten" fileDSK) (foreach text (mapcar'entget text-liste) (setq mtext (cdr(assoc 1 text))); end SETQ (princ "\nKM=" fileDSK)(prin1 mtext fileDSK) ); end FOREACH (close fileDSK) ); end DEFUN ;*********************************************************************************** ;**** finde - HOR Bohrung (LINR) **** ;*********************************************************************************** ; (defun finde-horbohr ( / aws ;** Auswahl-Satz der Texte cnt ;** Zähler PL-liste ;** Liste mit Text-ENAMES ) (Princ"\n\n Horizontale Bohrungen (nur Linien) wählen >") (setq aws (ssget'((0 . "LINE")(8 . "HORBOHR")))) (setq cnt 0) (if aws (repeat (sslength aws) (setq PL-liste (cons (ssname aws cnt) PL-liste) cnt (1+ cnt) ) ); end repeat ); end IF:Was gefunden PL-liste ); end DEFUN ;*********************************************************************************** ;**** schreibe-horbohr **** ;*********************************************************************************** ; (defun schreibe-horbohr (hor-liste datei-name / radius mitte ;** Kreis-mittel-Punkte fileDSK U-BKS-X;verschobenen X Ursprung BKS Merken U-BKS-Y ) (setq fileDSK (open datei-name"a")) (if (not fileDSK) ((lambda() (alert(strcat"\n\nKann Datei :\""datei-name"\" nicht öffnen.\n")) (exit) )) );end if (setq U-BKS-X (car (getvar "ucsorg"))) ;verschobenen X Ursprung BKS Merken (setq U-BKS-Y (cadr (getvar "ucsorg")));verschobenen Y Ursprung BKS Merken (foreach hor (mapcar'entget hor-liste) (setq Anfangspunkt (cdr(assoc 10 hor)) winkel (linien-winkel hor) laenge (linien-laenge hor) ); end SETQ ;(setq hordrm (getreal "\n *** Durchmesser Horizontaler Bohrer *** angeben :\n")) (princ"\n"fileDSK);** Leerzeile (princ"\n<103 \\BohrHoriz\\"fileDSK) (princ"\nMI=\"0\""fileDSK) (princ"\nXA="fileDSK)(prin1(rtos(-(car Anfangspunkt)U-BKS-X)2 4) fileDSK) (princ"\nYA="fileDSK)(prin1(rtos(-(cadr Anfangspunkt)U-BKS-Y)2 4) fileDSK) (princ"\nZA=\"D/2\""fileDSK) (princ"\nDU="fileDSK)(princ "\"" fileDSK)(prin1 hordrm fileDSK)(princ "\"" fileDSK) (princ"\nTI=\""fileDSK)(if (> laenge 35)(princ 35 fileDSK)(princ laenge fileDSK)) (princ "\""fileDSK) (princ"\nANA=\"20\""fileDSK) (princ"\nBM=\"C\""fileDSK) (princ"\nWI=\""fileDSK)(princ winkel fileDSK)(princ "\""fileDSK) (princ"\nAN=\"1\""fileDSK) (princ"\nAB=\"32\""fileDSK) (princ"\nHP=\"0\""fileDSK) (princ"\nSP=\"0\""fileDSK) (princ"\nYVE=\"0\""fileDSK) (princ"\nWW=\"50,51,52,53,93,94,95,56,153\""fileDSK) (princ"\nMX=\"0\""fileDSK) (princ"\nMY=\"0\""fileDSK) (princ"\nMZ=\"0\""fileDSK) (princ"\nMXF=\"1\""fileDSK) (princ"\nMYF=\"1\""fileDSK) (princ"\nMZF=\"1\""fileDSK) ); end FOREACH (close fileDSK) ); end DEFUN ; ;*********************************************************************************** ;**** linien-winkel **** ;*********************************************************************************** ; (defun linien-winkel (e-data / ;e-data ) ;(setq e-data (entget entity)) (cond ((="LINE"(cdr(assoc 0 e-data))) (angtos(ANGLE (cdr(assoc 10 e-data)) (cdr(assoc 11 e-data)) )) ); end Alt0:ist eine Linie ); end COND ); end DEFUN ;*********************************************************************************** ;**** linien-laenge **** ;*********************************************************************************** ; (defun linien-laenge (e-data / ;e-data ) ;(setq e-data (entget entity)) (cond ((="LINE"(cdr(assoc 0 e-data))) (distance (cdr(assoc 10 e-data)) (cdr(assoc 11 e-data)) ) ); end Alt0:ist eine Linie ); end COND ); end DEFUN (setq hordrm nil) ;----------------------------------------------------------- ;---- ---- ;---- Zukunfts-Investition - noch nicht benutzt ---- ;---- ---- ;----------------------------------------------------------- ; (defun *error* ( ) ; (princ "**** Befehl CNC abgebrochen *****") ; (command "_ucs" "w" "" ) ; (COMMAND "_undo" "_end") ; ) (defun *error* (msg) (princ "CNC Progamm abgebrochen: ") (princ msg) (command "_ucs" "w" "" ) (COMMAND "_undo" "_end") (princ) )