---

FAQ-CODE.zip

Sehr geehrte LISP Experten,

mein Problem ist die Fertigung eines Prototypen Werkzeuges, bei dem ein sehr filigraner Hinterschnitt zu fräsen ist. Mein CAM-Programmiersystem hat leider keine Lösung dafür. Ich versuche daher dieses 5-achs Programm von Hand zu schreiben. Ist auch nicht schwer, ich brauche nur die Punkte meiner Werkzeugbahn! Hier wollte ich mit ACAD (MDT4) ansetzen, da meine Kontor als Polylinie vorliegt. Ich habe bei der TU Graz einen tollen Quellcode für ein passendes Programm gefunden, nur funktioniert es leider nicht.
Nach der Auswahl der Polylinie und der Eingabe des Dateinamens und Speicherortes kommt folgende Fehlermeldung: Fehlerhafter Argumenttyp: stringp 2.0159

Im folgenden die Segmente des Quellcodes, von denen ich glaube für die gewünschte Funktion notwendig zu sein! (download von http://xarch.tu-graz.ac.at/autocad/news/faq/autolisp.html , im Dateianhang die komplette Liste der LISP Routinen, ca. 75)

;;; CDF - comma delimited string
(defun cdf-point (pt)
  (strcat (car pt) ", " (cadr pt) ", " (caddr pt)))

;;; SDF - space delimited, may easier be read back in to AutoCAD
(defun sdf-point (pt)
  (strcat (car pt) " " (cadr pt) " " (caddr pt)))

;;; convert this SDF format back to a point with
(defun str->point (s)
  (eval (read (strcat "(" s ")"))))

;;; Write a XYZ file of all selected objects (SDF see below)
(defun C:XYZ (/ ss fname f)
  (if (and (setq ss (ssget))
        (setq fname (getfiled "Write XYZ to file"
                (strcat (getvar "DWGNAME") ".XYZ") "XYZ" 7))
        (setq f (open fname "w")))
    (foreach ele (sslist ss)          ; -> [20.4]
      (foreach pt (getpts ele)        ; -> [23.1]
        (write-line (cdf-point pt) f)
      )
    )
  )
  (if f (close f))
)
;;; => <fname>.xyz
;;; 0.45, 12.3, -34.0

;;; For a ASC file (SDF-format) simply change all XYZ to ASC
;;; and cdf-point to sdf-point above.
(defun C:ASC (/ ss fname f)
  (if (and (setq ss (ssget))
        (setq fname (getfiled "Write ASC to file"
                (strcat (getvar "DWGNAME") ".ASC") "ASC" 7))
        (setq f (open fname "w")))
    (foreach ele (sslist ss)          ; -> [20.4]
      (foreach pt (getpts ele)        ; -> [23.1]
        (write-line (sdf-point pt) f)
      )
    )
  )
  (if f (close f))
)

;;; SSLIST - convert selection set to list. slow, but easy to write.
;;; Note: it's also wise to use ai_ssget, because some ents could be
;;;      on locked layers
;;; Ex: (sslist (ai_ssget (ssget))) => list of selected unlocked ents
;;; or  (mapcar 'entupd (sslist (ssget "X" '((8 . "TEMP")))))
;;;      - regens all entities on layer TEMP
(defun SSLIST (ss / n lst)
  (if (= 'PICKSET (type ss))
    (repeat (setq n (sslength ss))
      (setq n (1- n)
            lst (cons (ssname ss n) lst)))))

;;; return the vertex list of a polyline or of any other element
;;; Note that with edlgetent mentioned in [22.1] it's a one-liner
(defun GETPTS (ele / pts)
  (setq ele (entity ele))            ;force type ENAME
  (cond
    ((istypep ele "POLYLINE")
      (while (istypep (setq ele (entnext ele)) "VERTEX")
        ;; omit fit and spline points  (conservative style)
        (if (not (or (flagsetp 1 ele) (flagsetp 8 ele))) ;bugfix!
          (setq pts (cons (trans (getpt ele) ele 0) pts)))
        (reverse pts)))
    ;; Special case: you have to map it, assoc finds only the first.
    ;; Fix a LWPOLYLINE bug in R14: internally stored as 2d point,
    ;;  (entget) returns fantasy z-values.
    ((istypep ele "LWPOLYLINE")
      (mapcar '(lambda(pt)(trans (list (car pt)(cadr pt) 0.0) ele 0))
              (group-only 10 (entget ele))))
    ;; insert here possible other types, such as
    ((istypep ele '("TEXT" "CIRCLE")) (list (getpt ele)))
    ;; more like this (serge's style)
    (T (apply 'append (mapcar
      '(lambda (n / p) (if (setq p (getval n ele)) (list p)))
      '(10 11 12 13)))
    )
    ;; or like this (conservative style)
    ;;(T (foreach n '(10 11 12 13)
    ;;    (if (setq p (getval n ele)) (setq pts (cons p pts))))
    ;;  pts
    ;
  )
)

Ich habe hier und da mal kleine LISP Routinen geschrieben aber das überschreitet leider meine Fähigkeiten. Ich denke für jmd. mit mehr Wissen sollte dies Problem zu lösen sein. In diesem Sinne bitte ich um Eure Mithilfe...

Schon mal vielen Dank für die Mühe!

MfG.
Daniel

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Anderer Lösungsansatz:

Code:

---

(defun c:pline_to_file (/ theobj thelist n xval yval fname fn)
(vl-load-com)
(setq theobj (car (entsel "\nPolylinie auswählen: ")))
(setq theobj (vlax-ename->vla-object theobj))
(if (= (vlax-get-property theobj 'ObjectName) "AcDbPolyline")
(progn
(setq thelist (vlax-get-property theobj 'coordinates))
(setq thelist (vlax-safearray->list (variant-value thelist)))
(setq n 0)
(setq fname "C:/pline_to_file.txt")
(setq fn (open fname "w"))
(repeat (/ (length thelist) 2)
(setq xval (rtos (nth n thelist)))
(setq n (1+ n))
(setq yval (rtos (nth n thelist)))
(write-line (strcat xval "," yval) fn)
(setq n (1+ n))
)
(close fn)
(Princ
"\nDatei \"Punktkoordinaten.txt\" auf dem Laufwerk C abgespeichert."
)
)
(alert "Das war keine Polylinie !")
)
(princ)
)
(princ)

---

------------------
MfG Proxy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Danke für die Routine, funktioniert soweit sehr gut!

Ich versuche deinen Lösungsansatz erstmal für mich zu verarbeiten.. Sind Elemente darin, die ich noch nicht verstehe, aber ich bemüh mich.. Gibt es eigentlich eine Buchempfehlung für jemanden, der schnell und nicht zu tief in Lisp einsteigen will. Für mich scheint Lisp in der ACAD Umgebung ein nützliches Werkzeug zu sein! Hab bisher leider nur sehr sporadische Erfahrungen damit (3 kleine Routinen)..

Gruß
Daniel.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Online findest du auf Mapcars Seiten einen Super-Einstiegs-Tutorial in Lisp.

------------------
- Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Proxy,

habe diesen Beitrag gesucht und gefunden.

Deine Lisp-Routine macht das was auch ich benötige.

Gerne würde ich aber mehrere pline's der Reihe nach auswählen und speichern.

etwa in dem Stil

pline_1
x1,y1,x2,y2,x3,y3,xn,yn
pline_2
x1,y1,x2,y2,x3,y3,xn,yn
pline_3
x1,y1,x2,y2,x3,y3,xn,yn
.
.
.
Ich bin leider recht wenig bewandert im programmieren von Lisp.
Könntest Du mir vielleicht auf die Sprünge helfen bei den von mir o.g. Dingen

Grüße

hep

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Hep,

Willkommen im Forum!

Ein Hinweis vorweg: Das Forum ist kein MachtMalBitte- oder IchSucheEinProgramm-Forum. Hier werden Probleme bei der Programmierung selbst diskutiert.

Und dennoch poste ich Code. Das tue ich deshalb, weil man aus dem Vergleich von Proxys Code und dem, was ich daraus gemacht habe verschiedene Ansätze der Lösung erkennen kann. Es kann also für den Lernenden durchaus von Interesse sein.

Code:

---

(defun c:pline_to_file (/ wa thePL antw)
  (initget "Anhängen Neu")
  (setq antw (getkword "\nDaten an vorhandene Datei [Anhängen/Neu]<N>: ")
wa (if (= antw "Anhängen")
    "a"
    "w")
)
  (setq thePL (car (entsel "\nPolylinie auswählen: "))
thePL (if (and thePL
      (= (vlax-get-property (setq thePL (vlax-ename->vla-object thePL)) 'ObjectName) "AcDbPolyline"))
thePL
)
)
  (while thePL
    (pline_to_file wa thePL)
    (setq wa "a")
    (setq thePL (car (entsel "\nPolylinie auswählen: "))
  thePL (if (and thePL
      (= (vlax-get-property (setq thePL (vlax-ename->vla-object thePL)) 'ObjectName) "AcDbPolyline"))
thePL
)
  )
    )
  (princ)
  )
(defun pline_to_file (sa theobj / thelist fname fn)
  (setq thelist (vlax-get-property theobj 'coordinates)
thelist (vlax-safearray->list (variant-value thelist))
fname "C:/pline_to_file.txt"
fn (open fname sa)
)
  (write-line "NEWLINE" fn)
  (write-line (substr (apply 'strcat
    (mapcar '(lambda (E)
(strcat","(rtos E))
)
    thelist)
    )
      2)
    fn)
  (close fn)
  (Princ
    "\nDatei \"Punktkoordinaten.txt\" auf dem Laufwerk C abgespeichert."
    )
  )
(vl-load-com)

---

Bei Fragen ...

Grüße Holger

------------------
Holger Brischke
CAD on demand GmbH                              Autodesk User Group Central Europe
Individuelle Lösungen von Heute auf Morgen.              AUGCE Manager Deutschland

Jackpot on demand - Wir eröffnen den Spätsommer mit einer Verlosung!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Holger,

zuerst einmal möchte ich mich bedanken für die freundliche Hilfe.

Ich möchte aber auch auf Deine einleitenden Worte antworten.

Für mich steht das außer Frage das man in einem Forum nicht auftreten kann mit der Forderung mach mal eben. Das war ganz betimmt nicht meine Intension. Wie ich geschrieben habe, habe ich (noch) wenig Kenntnisse in Lisp. Ich hoffe das ich meine Kenntnisse erweitern kann und das tut man am besten mit learning by doing. Am Anfang über Probleme diskutieren ist doch aber recht schwer, weil das eigentlich Problem darin liegt das man die "Sprache" noch nicht spricht oder versteht.

Mit meinen Versuchen Proxys Code zu ergänzen bin ich gescheitert, deswegen habe ich hier nachgefragt. Wenn ich jetzt Deinen und Proxys vgergleiche sehe ich natürlich woran ich gescheitert bin.

Zitat: Es kann also für den Lernenden durchaus von Interesse sein.

Genau so ist es.

Grüße

Edgar

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Edgar,

in deinem Posting hätte man es, wenn überhaupt, nur mit boshafter Absicht zwischen den Zeilen lesen können, dass versucht würde Code abzustauben.
Ich weise dennoch darauf hin, so dass das Forum eben nicht dahingehend an Inhalten verarmt.

Und wenn du Fragen zum Code hast ...

Grüße Holger

------------------
Holger Brischke
CAD on demand GmbH                              Autodesk User Group Central Europe
Individuelle Lösungen von Heute auf Morgen.              AUGCE Manager Deutschland

Jackpot on demand - Wir eröffnen den Spätsommer mit einer Verlosung!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Holger,

hätte da schon mal eine Frage zur Ausgabe des Zahlenformats.

ich kenne z.B.
.... (print rtos (car sp) 2 4) "," (rtos (cadr sp) 2 4) ","
(rtos (caddr sp) 2 4) "," (rtos (car ep) 2 4) "," (rtos (cadr ep) 2 4) "," (rtos (caddr ep) 2 4).............

bei Dir steht  (write-line (strcat xval "," yval) fn). Ich denke das wir mit mapcar erledigt, nur wie?

Kannst Du mir das bitte sagen.

Gruß

Edgar

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Edgar,

ich habe die wohl entscheidende Stelle für dich mal kommentiert. Vielleicht hilfts.

Code:

---

(write-line;schreibe in Datei fn
(substr;Gib die Zeichenkette ab dem 2. Zeichen wieder (das erste ist ein Komma)
  (apply 'strcat;das Ergebnis der folgenden [mapcar ..] ist eine Liste, deren Elemente (STR) miteinander verbunden verden
        (mapcar;Führe mit die Funktion [lambda..] aus und gib das Ergebnis zurück
          '(lambda (E)
            ;E ist ein Element der Liste
            (strcat;Zeichenkettenverbinden
              ","
              (rtos E);Umwandlung REAL in STR
              )
            )
          thelist);Die Liste, die [mapcar ..] verwendet
        )
  2)
fn)

Bei Fragen ...

Grüße Holger

---

------------------
Holger Brischke
CAD on demand GmbH                              Autodesk User Group Central Europe
Individuelle Lösungen von Heute auf Morgen.              AUGCE Manager Deutschland

Jackpot on demand - Wir eröffnen den Spätsommer mit einer Verlosung!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Holger,

es hift schon aber....

Kannst du mir bitte sagen was man hier schreiben muß um ggf. 2 oder 0 Nachkommastellen zu erhalten ( (substr;Gib die Zeichenkette ab dem 2. Zeichen wieder (das erste ist ein Komma) )

1234,5678 -->> 1234,56 oder 1234
        ^---- ist das das 2.Zeichen
      ^---- oder das

aber die Logik verstehe ich nicht, weil eben nur 4 Nachkomastellen geschrieben werden (ich dachte Autocad arbeitet mit 16 Stellen nach dem Koma)

Vielleicht findest Du Zeit mir eine kurze Erklärung zu geben.

Grüße

Edgar

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Edgar,

in welcher Entwicklungsumgebung programmierst du denn? Nimm mal den VLIDE und setze an der ersten öffnenden Klammer einen Haltepunkt (F9). Dann lädst du das Programm und startest es. Das Programm stoppt nun an dieser Stelle. Du schaltest dir nun das Überwachungsfenster ein und lässt dir die letzte Rückkabe anzeigen. Du kannst nun mittels F8 im Einzelschritt durch den Code 'wandern' und siehst im Überwachungsfenster das jeweiligen Ergebnis der einzelnen Befehle. Ich denke, wenn du dies gemacht hast, wirst du schlauer sein.
Nimm dir auch die Auto/VLISP-Hilfe mal zur Hand. Dann wirst du recht schnell erkennen, dass
(substr - eine Teilzeichenkette eines Strings wiedergibt
(rtos - Reals in String umwandelt, dabei die Einstellungen der Systemvariablen UNITMODE, DIMZIN, LUNITS und LUPREC eine Rolle spielen.

Verstehe meine Antwort bitte nicht falsch, wenn ich hier auf die Hilfe verweise. Wir diskutieren hier in einem Forum, weshalb gewisse Grundlagen vorausgesetzt werden (müssen). Grundsätzliche Dinge zu erklären würde bei zweifelhaftem Ergebnis den Aufwand der freiwilligen Hilfe erheblich steigern. Das ist jetzt kein Abwürgen.
Ich schreibe dies deshalb, weil ich in deiner Antwort zu erkennen glaube, dass dir die Wirkung der einzelnen Befehle nicht bekannt ist. (substr hat überhaupt gar nichts mit der Anzahl der Kommastellen einer Zahl zu tun. (substr entfernt lediglich das Trennzeichen (das Komma) der X- und Y-Werte der TExtzeile vom Anfang des Strings, da dieses, um den Code kurz zu halten, in der (mapcar-Funktion zunächst angefügt wurde, in der endgültigen Textzeile dort aber nichts zu suchen hat.

Bei Fragen ...

Grüße Holger

------------------
Holger Brischke
CAD on demand GmbH                              Autodesk User Group Central Europe
Individuelle Lösungen von Heute auf Morgen.              AUGCE Manager Deutschland

Jackpot on demand - Wir eröffnen den Spätsommer mit einer Verlosung!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Holger,

ne das ist schon in Ordnung. Ich verstehe das auch nicht falsch. Ohne Grundkenntnis geht es nicht und genau das bin ich mir am aneignen. Ich werde das so wie du vorgeschlagen hast machen,  ggf. werde ich nachfragen.

Grüße

Edgar

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Community,

erst einmal vielen Dank für das hier von euch geteilte Wissen!

Ich stehe vor der Aufgabe, Raumpolygone in eine räumliche Datenbank (MS SQL SERVER 2008) zu überführen. Mittels des Beitrags von Holger vom 23.08.05 (http://ww3.cad.de/foren/ubb/Forum145/HTML/001248.shtml#000005) konnte ich die X- und Y-Koordinaten aller relevanten Raumpolygone einer Zeichnung in eine Textdatei extrahieren (Vielen Dank für die Hilfe!  10 unities sind überwiesen)

Zur Überführung in die Datenbank ist jedoch ein spezielles Format notwendig.
Da ich selbst erst Anfänger in Sachen Lisp bin, findet sich hier vielleicht jemand, der mir bei einer Erweiterung von Holgers Code helfen könnte?

Das ausgegebene Format lautet pro extrahiertem Polygon:

Code:

---

NEWLINE
X1,Y1,X2,Y2,X3,Y3,X4,Y4

---

Der Einfügebefehl von SQL-Server benötigt hingegen folgendes Format:

Code:

---

INSERT INTO raumtabelle (geometriespalte) VALUES  (geometry::STPolyFromText('POLYGON((X1 Y1,X2 Y2,X3 Y3,X4 Y4,X1 Y1))', 0));

---

Die Schwierigkeit ist dabei:
- dass zwischen X und Y eines Eckpunktes ein Leerzeichen,
- nach einem XY-Paar jedoch ein Komma,
- und am Ende der Auflistung wieder der erste Eckpunkt angegeben werden muss (um das Polygon zu schließen).

Ich habe es mit Suchen und Ersetzen des Kommas sowie regulären Ausdrücken (entsprechend meinem Kenntnisstand) versucht, aber leider ohne hinreichenden Erfolg 

Wisst Ihr vielleicht weiter, wie sich die Ausgabe ergänzen ließe?

Vielen Dank für das Lesen bis hierher und für eure Hilfe

Schöne Grüße aus Berlin

Micha

---

Hallo Communitiy,

da ich VBA besser beherrsche, habe ich die Daten in Excel importiert und mir mit einem kleinem VBA-Makro beholfen.
Das ist ganz sicher nicht der Königsweg - eine reine Lisp-Lösung würde mir das aufwändige Umwandeln ersparen!

Hilfe in Lisp ist daher immer noch sehr willkommen   

Code:

---

Public Sub verketteXY()
'Verkettet alle markierten X- und Y-Koordinaten mti wechselndem Komma und umschliesst sie mit dem (MS) SQL-Insert-Befehl für Polygone.
'
'Erwartet, dass:
' - alle Koordinaten eines Polygons in einer Zeile stehen und markiert wurden
' - X1 jeweils in Spalte 2 steht
' - Y1 jeweils in Spalte 3 steht
' Das Ergebnis wird jeweils in Spalte 1 geschrieben
Dim i As Long 'der Zaehler
Dim rng As Range 'Referenz auf die Zellauswahl
Dim sQuery As Variant 'die zusammenzusetzende Befehlsfolge für den SQL Server
   
    Set rng = Selection 'referenziere die aktuelle Zell-Auswahl im Excel-Arbeitsblatt
    i = 0 'setze den Zaehler auf 0
    'Der Beginn des Insert-Befehls - noch ohne Argumente:
    sQuery = "INSERT INTO ra_geom (ra_geom) VALUES (geometry::STPolyFromText('POLYGON(("
    'Für jede Zelle in der aktuellen Auswahl:
    For Each c In Selection.Cells
        'bei jeder zweiten Zelle...
        'ersetze ggf. das Komma durch den Punkt als Dezimaltrennzeichen:
        c.Value = Replace(c.Value, ",", ".")
        If ((i Mod 2) = 0) Then '...ausgenommen nach der allerersten Zelle:
            'füge (k)ein Komma nach dem Wert ein:
            If (i = 0) Then
                sQuery = sQuery & " " & c.Value
            Else
                sQuery = sQuery & ", " & c.Value
            End If
        Else
            sQuery = sQuery & " " & c.Value
        End If
        i = i + 1
    Next c 'naechste Zelle:
    'der Wert von X1 wurde in die Spalte 2 kopiert und nun wieder ans Ende des Strings kopiert:
    Set rng = Cells(Selection.Row, 2)
    rng.Value = Replace(rng.Value, ",", ".") 'ersetze Komma durch Punkt
    sQuery = sQuery & ", " & rng.Value
    'analog der Wert von Y1 in Spalte 3
    Set rng = Cells(Selection.Row, 3)
    rng.Value = Replace(rng.Value, ",", ".") 'ersetze Komma durch Punkt
    sQuery = sQuery & "  " & rng.Value
    'schliesse den Insert-Befehl ab:
    sQuery = sQuery & "))', 0));"
    'schreibe den Befehl in Spalte 1 der jeweiligen Zeile:
    Cells(Selection.Row, 1).Value = sQuery

End Sub

---

Schönen Tag noch
Micha

Edited: 2008-04-23: - Verkettung der Zeichenkette mit & statt vorher +
                    - Ersetzen des Kommas durch Punkt eingefügt

[Diese Nachricht wurde von mhol25 am 23. Apr. 2008 editiert.]