---

Kr2Pl.txt

Guten Morgen,
ich habe hier ein super Lisp (siehe Anhang), dieses Lisp wandelt Kreise in Polylinien um, und löscht dann den Kreis. Ist es möglich dieses so umzuschreiben das man mehrere Kreise (durch ein Kreuzen-Fenster) markieren kann?

Gruß aus Lüneburg
Matze

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

---

Klar - ist nicht weiter schwer - frag mal den Ersteller des Programms - den habe ich hier auf dem Board schonmal gesehen

------------------
Gruß
CADwiesel
Besucht uns im CHAT

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

---

aber da der Holger momentan stark beschäftigt ist, probier mal folgendes:

(defun DT:CIRCLE->LWPL (CIRCLE / OBJDATA MIDLEPKT RADIUS)
  (if(and(=(type CIRCLE)'ENAME)
        (setq OBJDATA(entget CIRCLE))
        (=(cdr(assoc 0 OBJDATA))"CIRCLE")
    ) 
    (progn
      (setq MIDLEPKT (cdr (assoc 10 OBJDATA))
            RADIUS  (cdr (assoc 40 OBJDATA))
      )
      (entmake
        (vl-remove-if '(lambda(X) (not(cdr X)))
          (list
            '(0  .  "LWPOLYLINE"  )
            '(100 .  "AcDbEntity"  )
            (cons  67  (cdr(assoc  67 OBJDATA))  )
            (cons 410  (cdr(assoc 410 OBJDATA))  )
            (cons  8  (cdr(assoc  8 OBJDATA))  )
            (cons  62  (cdr(assoc  62 OBJDATA))  )
            (cons 420  (cdr(assoc 420 OBJDATA))  )
            (cons 430  (cdr(assoc 430 OBJDATA))  )
            (cons  6  (cdr(assoc  6 OBJDATA))  )
            (cons  48  (cdr(assoc  48 OBJDATA))  )
            (cons 370  (cdr(assoc 370 OBJDATA))  )
            '(100 . "AcDbPolyline"  )
            '(90 . 2)
            '(70 . 1)
            '(43 . 0.0)
            '(38 . 0.0)
            '(39 . 0.0)
            (cons 10 (list (+ (car MIDLEPKT) RADIUS) (cadr MIDLEPKT)))
            '(40 . 0.0)
            '(41 . 0.0)
            '(42 . 1.0)
            (cons 10 (list (- (car MIDLEPKT) RADIUS) (cadr MIDLEPKT)))
            '(40 . 0.0)
            '(41 . 0.0)
            '(42 . 1.0)
            '(210 0.0 0.0 1.0)
          )
        )
      ) 
      (entdel (cdr(assoc -1 OBJDATA)))           
    )
  ) 
  (princ)
)
(defun C:CIRCLE->LWPL ( / AUSWAHL CIRCLE INDEX)
  (if(or(setq AUSWAHL (ssget "I"  '((0 . "CIRCLE"))))
        (setq AUSWAHL (ssget      '((0 . "CIRCLE"))))
    )
    (progn
      (setq INDEX -1)
      (repeat(sslength AUSWAHL)
        (DT:CIRCLE->LWPL (ssname AUSWAHL (setq INDEX(1+ INDEX))))
      ) 
    )
  )
)
Aber ansonsten gilt natürlich Wiesels Bemerkung: Wenn man den Programmersteller kennt, bei Problemen sich immer zuerst an den Programmierer wenden!

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

[Diese Nachricht wurde von CADmium am 17. Nov. 2004 editiert.]

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

---

...aber der Holger hat doch zu viel zu tun, Wiesel....

Code:

---

;;; Kreis wird gelöscht!
;;;
;;;Holger Brischke
;;;Geisberg 84
;;;66132 Saarbrücken
;;;brischke@planet-interkom.de
;;;
;;; Erweitert um multiple Auswahlmöglichkeit von Marc Scherer :-)
(defun C:MK2P (/ LI OBJ MPT RA SGET)
  (if (setq SGET (ssget (list (cons 0 "CIRCLE"))))
    (if (setq SGET (DT:SELSET->ENAMELIST SGET))
      (progn
        (setq SGET (mapcar 'entget SGET))
        (foreach LI SGET
          (setq MPT (cdr (assoc 10 LI))
                RA  (cdr (assoc 40 LI))
          ) ;_ end of setq
          (entmake (list
                    '(0 . "LWPOLYLINE")
                    '(100 . "AcDbEntity")
                    '(67 . 0)
                    '(410 . "Model")
                    (cons 8 (cdr (assoc 8 LI)))
                    '(100 . "AcDbPolyline")
                    '(90 . 2)
                    '(70 . 1)
                    '(43 . 0.0)
                    '(38 . 0.0)
                    '(39 . 0.0)
                    (cons 10 (list (+ (car MPT) RA) (cadr MPT)))
                    '(40 . 0.0)
                    '(41 . 0.0)
                    '(42 . 1.0)
                    (cons 10 (list (- (car MPT) RA) (cadr MPT)))
                    '(40 . 0.0)
                    '(41 . 0.0)
                    '(42 . 1.0)
                    '(210 0.0 0.0 1.0)
                  ) ;_ end of list
          ) ;_ end of entmake
          (entdel (cdr (assoc -1 LI)))
          (princ "\nOk!")
        )
      ) ;_ end of if
    )
  )
  (princ)
) ;_ end of defun

(defun DT:SELSET->ENAMELIST (SELSET / INDEX RETVAL)
  (if (eq (type SELSET) 'PICKSET)
    (progn
      (setq INDEX 0)
      (repeat (sslength SELSET)
        (setq RETVAL (cons (ssname SELSET INDEX) RETVAL)
              INDEX  (1+ INDEX)
        ) ;_ end of setq
      ) ;_ end of repeat
    ) ;_ end of progn
  ) ;_ end of if
  retval
) ;_ end of defun   

---

...

------------------
Ciao,
Marc

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

---

hallo,
ich habe gerade beim aktualisieren der Seite gesehen, daß die passenden Antworten wohl schon da sind, ich stelle es trotzdem nochmal rein

;;; Kreis wird gelöscht!
;;;
;;;Holger Brischke
;;;Geisberg 84
;;;66132 Saarbrücken
;;;brischke@planet-interkom.de
;;;
;;;Auswahl mehrerer Kreise, Jörn Bosse 17.11.04
;;;=> Änderung der Funtion f:select
;;;=> Änderung der Funktion c:k2p

(defun c:k2p (/ li obj mpt ra n)
  (setq n 0)
  (princ (strcat "\n" (itoa n) " Kreise in Polylinie."))
  (if (setq obj (f:select))
   
      (mapcar '(lambda(A)
    (setq n (+ n 1))    
    (setq li (entget A))
   
  (if li
    (progn
      (setq mpt (cdr (assoc 10 li))
            ra  (cdr (assoc 40 li))
            ) ;_ end of setq
      (entmake (list
                '(0 . "LWPOLYLINE")
                '(100 . "AcDbEntity")
                '(67 . 0)
                '(410 . "Model")
                (cons 8 (cdr (assoc 8 li)))
                '(100 . "AcDbPolyline")
                '(90 . 2)
                '(70 . 1)
                '(43 . 0.0)
                '(38 . 0.0)
                '(39 . 0.0)
                (cons 10 (list (+ (car mpt) ra) (cadr mpt)))
                '(40 . 0.0)
                '(41 . 0.0)
                '(42 . 1.0)
                (cons 10 (list (- (car mpt) ra) (cadr mpt)))
                '(40 . 0.0)
                '(41 . 0.0)
                '(42 . 1.0)
                '(210 0.0 0.0 1.0)
                ) ;_ end of list
              ) ;_ end of entmake
      (entdel (cdr(assoc -1 li)))
      (princ (strcat "\r" (itoa n) " Kreise in Polylinie."))
      ) ;_ end of progn
    ) ;_ end of if
)obj); end mapcar
(princ "\nEs wurden keine Kreise ausgewählt."))
  (princ)
  ) ;_ end of defun

;;;mehrere Kreise auswählen
(defun f:select (  / aws n liste)
  (princ "\Bitte Kreise auswählen:")
  (setq aws (ssget (list '(0 . "CIRCLE")))
n 0)
  (if aws
    (repeat (sslength aws)
      (setq liste (append liste (list (ssname aws n)))
    n (+ n 1))))
  liste)

------------------
viele Grüße

Jörn

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

---

Vielen Dank an alle, ich habe alle Programme getestet (funktioniert prima).
Werde mich das nächste mal natürlich wirklich erstmal an den Programmierer wenden.

CADwiesel bekommt auch 10 Units, weil er Holger schonmal hier im Board gesehen hat, und natürlich auch Recht haz.
Gruß Matze

[Diese Nachricht wurde von Tulsa am 17. Nov. 2004 editiert.]

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

---

Als Lisp-Anfänger bin ich wahrscheinlich zu doof.
Ich krieg`das Lisp nicht in Gang.
Beim appload kommt noch die Meldung: " k2p.lisp erfolgreich geladen."
Schließe ich jedoch das appload-Fenster kommt die Meldung:
" ; Fehler: Fehlerhafter Lesevorgang für Zeichen (Oktal). 21 "
Was mach ich falsch ?
(Ich hab schon im Forum gesucht, aber nichts gefunden).
Schlagt nicht zu sehr auf mich ein !

------------------
manne

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

---

Außerdem gibt es noch den schönen Befehl "UMGRENZUNG"
( nicht nur für Kreise ).

Gruß Carsten

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

---

Hallo Matze,

weil alle was reinstellen, mache ich es auch.

Tool 8 von hier http://www.lehrer.uni-karlsruhe.de/~za685/cad/cadtools.htm

tut es auch und noch ein bischen mehr.

Zum Schluss noch die einfachste Methode:
Zeichne gleich einen Ring, dann hast Du eine Polylinie,
Wenn der Kreis schon vohanden ist, kannst Du (mit einem anderen Layer), einen Ring darüberzeichnen und danach den Kreis löschen.

Ein schönes Wochenende

Theodor Schönwald

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

---

Nur zu Info!
Falls noch jemand, so wie ich, auf die Idee kommt eines der LispŽs hier in AutoCAD 2015 zu nutzen ;-)
Ausgangssituation:
Alle Kreise einer DWG in Polylinien umwandeln.
Das Lisp von CADmium funktioniert ohne Probleme unter AutoCAD 2015 (konnte jedenfalls keine Feststellen).
Das Lisp von Marc und Jörn veranstalten, zumindest bei der Auswahl "alle", etwas durcheinander. Es werden nämlich alle Kreise die in Layouts vorhanden sind in den Modelbereich kopiert, teilweise auch aus den Layouts gelöscht.

Gruß
Jörg

------------------
Wer immer tut, was er schon kann, bleibt immer das, was er schon ist.
Menschen mit einer neuen Idee gelten so lange als Spinner, bis sich die Sache durchgesetzt hat.
Das schöne an AutoCAD ist ja, dass einem jede Möglichkeit bietet damit zu machen was man will und wie man es will. Was jeder unglücklicherweise auch tut ;-)

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

---

Das war in 2004 wie auch heute wohl nur für den Modellbereich gedacht,
leider wurde die Anwendung im Layout nicht untersagt 

Die Zeile
'(410 . "Model")
gegen
(cons 410 (getvar "CTAB"))
tauschen

Das der Ablauf jedoch "mal so und mal so" ausfällt, kann aber eigentlich nicht sein.

------------------
CAD on demand GmbH - Beratung und Programmierung rund um AutoCAD

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

---

Zitat:

---

Original erstellt von cadffm:
Das war in 2004 wie auch heute wohl nur für den Modellbereich gedacht,
leider wurde die Anwendung im Layout nicht untersagt  

Die Zeile
'(410 . "Model")
gegen
(cons 410 (getvar "CTAB"))
tauschen

Das der Ablauf jedoch "mal so und mal so" ausfällt, kann aber eigentlich nicht sein.

---

Das ändert nichts, das Problem bleibt. Bis auf das der Kreis im Layout jetzt ein Kreis bleibt. Ins Modell Kopiert werden sie trotzdem.
Anbei mal meine Änderung:

Zitat:

---

;;; Kreis wird gelöscht!
;;;
;;;Holger Brischke
;;;Geisberg 84
;;;66132 Saarbrücken
;;;brischke@planet-interkom.de
;;;
;;; Erweitert um multiple Auswahlmöglichkeit von Marc Scherer :-)
(defun C:K2P (/ LI OBJ MPT RA SGET)
  (if (setq SGET (ssget (list (cons 0 "CIRCLE"))))
    (if (setq SGET (DT:SELSET->ENAMELIST SGET))
      (progn
        (setq SGET (mapcar 'entget SGET))
        (foreach LI SGET
          (setq MPT (cdr (assoc 10 LI))
                RA  (cdr (assoc 40 LI))
          ) ;_ end of setq
          (entmake (list
                    '(0 . "LWPOLYLINE")
                    '(100 . "AcDbEntity")
                    '(67 . 0)
                    (cons 410 (getvar "CTAB"))
                    (cons 8 (cdr (assoc 8 LI)))
                    '(100 . "AcDbPolyline")
                    '(90 . 2)
                    '(70 . 1)
                    '(43 . 0.0)
                    '(38 . 0.0)
                    '(39 . 0.0)
                    (cons 10 (list (+ (car MPT) RA) (cadr MPT)))
                    '(40 . 0.0)
                    '(41 . 0.0)
                    '(42 . 1.0)
                    (cons 10 (list (- (car MPT) RA) (cadr MPT)))
                    '(40 . 0.0)
                    '(41 . 0.0)
                    '(42 . 1.0)
                    '(210 0.0 0.0 1.0)
                  ) ;_ end of list
          ) ;_ end of entmake
          (entdel (cdr (assoc -1 LI)))
          (princ "\nOk!")
        )
      ) ;_ end of if
    )
  )
  (princ)
) ;_ end of defun
(defun DT:SELSET->ENAMELIST (SELSET / INDEX RETVAL)
  (if (eq (type SELSET) 'PICKSET)
    (progn
      (setq INDEX 0)
      (repeat (sslength SELSET)
        (setq RETVAL (cons (ssname SELSET INDEX) RETVAL)
              INDEX  (1+ INDEX)
        ) ;_ end of setq
      ) ;_ end of repeat
    ) ;_ end of progn
  ) ;_ end of if
  retval
) ;_ end of defun   

---

Der Ablauf ist nicht mal so mal so, da hatte ich mich vllt. etwas schwammig ausgedrückt. Wenn ich eine DWG mit drei Kreisen habe (einer im Modell, einer im Layout1, einer im Layout2) passiert folgendes: Kreis im Model wird in Polylinie umgewandelt, Kreis aus Layout1 ist gelöscht, Kreis in Layout2 bleibt ein Kreis. Zudem sind dann auch die Kreise aus den LayoutŽs im Modell vorhanden.

P.S. Ich brauche das Lisp eigentlich auch nicht geändert, da ich über ScriptPro ein Script ablaufen lasse, was mir nur Kreise eines bestimmten Layers (die restlichen Layer sind gefroren) in Polylinien umwandelt. Da diese Layer zumindest bei uns, ohnehin nur im Modell vorhanden sind, wird auch nichts aus dem Layout kopiert. Mir ist das verhalten letztendlich aufgefallen, weil in zwei der 300 DWGŽs Kreise im Layout auf Layer "0" (der laut Pflichtenheft eigentlich leer sein sollte) lagen, den ich ja nicht frieren kann (da aktuell) und somit in den Modelbereich kopiert wurden. Halb so wild! 

Gruß
Jörg

------------------
Wer immer tut, was er schon kann, bleibt immer das, was er schon ist.
Menschen mit einer neuen Idee gelten so lange als Spinner, bis sich die Sache durchgesetzt hat.
Das schöne an AutoCAD ist ja, dass einem jede Möglichkeit bietet damit zu machen was man will und wie man es will. Was jeder unglücklicherweise auch tut ;-)

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

---

Probier mal folgendes:

Unter die Zeile:

  RA  (cdr (assoc 40 LI))

noch folgende eintragen:

  LT (cdr (assoc 410 LI))

und die (neue) Zeile:

(cons 410 (getvar "CTAB"))

gegen:

(cons 410 LT)

tauschen.

HTH

Gruß
Thomas

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

---

Zitat:

---

Original erstellt von spider_dd:
Probier mal folgendes:

Unter die Zeile:

   RA  (cdr (assoc 40 LI))

noch folgende eintragen:

   LT (cdr (assoc 410 LI))

und die (neue) Zeile:

(cons 410 (getvar "CTAB"))

gegen:

(cons 410 LT)

tauschen.

HTH

Gruß
Thomas

---

Hallo Thomas,

jetzt sieht es wie folgt aus:
Im Modell ist der Kreis eine Polylinie (Kreis gelöscht)
Im Layout1 ebenfalls
Im Layout2 ist sowohl der Kreis wie auch eine Polylinie vorhanden 
Logisch ist das irgendwie nicht.

------------------
Wer immer tut, was er schon kann, bleibt immer das, was er schon ist.
Menschen mit einer neuen Idee gelten so lange als Spinner, bis sich die Sache durchgesetzt hat.
Das schöne an AutoCAD ist ja, dass einem jede Möglichkeit bietet damit zu machen was man will und wie man es will. Was jeder unglücklicherweise auch tut ;-)

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

---

Zitat:

---

Original erstellt von spider_dd:
Probier mal folgendes:

---

Nee, mach das nicht.

Das Problem ist ENTDEL zum löschen der Objekte, das mag so Layoutgeschichten gelegentlich nicht so recht,
arbeitet lieber im aktuellen Bereich.

Aber da ich jetzt verstehe wie du das anwendest muß ich meine Antwort auch ändern  
Ich ging nicht davon aus das jemand ALLE wählt, oder auch (ssget "_X" ..)

Die Zeile
'(410 . "Model")
gegen
(assoc 410 LI)
tauschen

hätte es heißen müssen.

Das Problem mit ENTDEL würde man wegbekommen wenn man
(vla-delete (vlax-ename->vla-object (cdr(assoc -1 LI))))
einsetzt, dann kann man aber auch so lustige sachen wie
(cons 8 (cdr (assoc 8 li)))
gegen
(assoc 8 li)
tauchen usw.
und der Gruppencode 67.. ach was solls

altes Zeug  

------------------
CAD on demand GmbH - Beratung und Programmierung rund um AutoCAD

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

---

Zitat:

---

Original erstellt von cadffm:

Die Zeile
'(410 . "Model")
gegen
(assoc 410 LI)
tauschen

hätte es heißen müssen.

---

Gleiches Problem wie im Post vorher beschrieben ;-)
Ich wollte auch keine große Sache daraus machen, sondern nur darauf hinweisen das, dass Problem existiert. Falls es nämlich jemand einfach so benutzt, weil er meint alle Kreise müssen jetzt Polylinien sein, zerschießt man sich leicht z.B. Legenden die Kreise enthalten bzw. sind die Kreise davon im Modell. Man bemerke, das die Kreise im zuletzt aktiven Layout, bevor man wieder ins Modell wechselt, gelöscht werden und in allen anderen Layouts sowohl Kreis wie auch Polylinie vorhanden sind.
Warum ich das überhaupt genutzt habe:
Wir haben ein CAFM System das die Polygone (Layer: Flächen, Abzugsflächen) aus unseren dwgŽs ausliest.
Das System erkennt dann, das innerhalb einer Fläche Abzugsflächen vorhanden sind und zieht diese ab. Leider erkennt das System keine Kreise, Ellipsen, sondern nur Polygone. Also werden z.B. Säulen bei der Berechnung nicht abgezogen. Logisch!
Da die Programmierer es nicht hinbekommen Kreise mit in das System aufzunehmen, hatte ich den Auftrag alle Kreise die auf dem Layer "Flächen" und "Abzugsflächen" liegen in Polylinien umzuwandeln. Da ich aber zu faul war 100derte Pläne zu öffnen (das wäre der eigentliche Auftrag gewesen) und nach Kreisen auf besagten Layern zu suchen, habe ich mir die Lisp hier in ein Makro eingebaut.
Das Makro friert alle Layer, taut dann die zwei Flächen-Layer, führt das Lisp aus und stellt den Layerstand wieder her. Somit war das Thema für mich durch.
Aufgefallen ist mir der Fehler dann als ich mir das Log-File von ScriptPro angeschaut habe und in einem Gebäude 69 Kreise in Polylinien umgewandelt wurden von dem ich weiß, das darin gar keine Säulen (Kreise) existieren. Als ich mir die DWG dazu angeschaut habe, ist mir das verhalten dann aufgefallen: Kreise auf Layer "0" der ja ebenfalls nicht gefroren war (da aktuell) wurden vom Layout ins Modell kopiert.

Man hätte das Lisp sicherlich auch so umschreiben können, dass es nur auf bestimmte Layer angewendet wird, aber dazu reichen meine Lisp-Kenntnisse bei weitem noch nicht aus :-( Aber ich habe ja mein gewünschtes Ergebnis :-)

So jetzt ist aber auch gut :-) Hab wieder was gelernt! Vielen Dank!!!

Gruß und schönen Feierabend

------------------
Wer immer tut, was er schon kann, bleibt immer das, was er schon ist.
Menschen mit einer neuen Idee gelten so lange als Spinner, bis sich die Sache durchgesetzt hat.
Das schöne an AutoCAD ist ja, dass einem jede Möglichkeit bietet damit zu machen was man will und wie man es will. Was jeder unglücklicherweise auch tut ;-)

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

---

Nochmal. Das Problem was noch besteht und die Verwendung von ENTDEL, also das plötzlich doch noch zusätzlich ein Kreis da ist.

Wusste selbst nicht bis heute das es damit Probleme geben KANN bei nicht aktiven Bereichen.

------------------
CAD on demand GmbH - Beratung und Programmierung rund um AutoCAD

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

---

ACHTUNG! Sie antworten auf einen Beitrag der älter als 1 Jahr ist!

Zitat:

---

Original erstellt von Tulsa:
Guten Morgen,
ich habe hier ein super Lisp (siehe Anhang), dieses Lisp wandelt Kreise in Polylinien um, und löscht dann den Kreis. Ist es möglich dieses so umzuschreiben das man mehrere Kreise (durch ein Kreuzen-Fenster) markieren kann?

Gruß aus Lüneburg
Matze

---

Zuerst mal: es ist immer sinnvoll, Lisp-Funktionen so einfach und so allgemein verwendbar wie nur möglich zu schreiben. Das bedeutet hier, dass es eine Funktion gibt, die ein einzelnes Kreisentity in eine Polylinie umwandelt. Diese Funktion kannst Du dann einfach auf alle Elemente einer Liste von Entities oder auch eines Auswahlsatzes anwenden. Das Löschen des Ursprungselements wird dann selbstverständlich auch getrennt erledigt, weil Du irgendwann man auch eine Funktion brauchst, bei der das Ursprungselement erhalten bleibt.

Und wenn wir schon dabei sind, warum soll diese Funktion nur mit Kreisen funktionieren? Warum nicht auch für Kreisbögen, für Polylinen mit Kreisbögen, für Ellipsen und Ellipsenbögen und für Splines?

Und da hab' ich was für Dich:

Code:

---

(defun at-curve->poly (en / ACCURACY el closedflag lastent len vertexnumber stparam endparam
      diffparam startpt endpt)
  (if (not AT:CURVE->POLY-ACCURACY)
    (setq AT:CURVE->POLY-ACCURACY 0.01)
    )
  (setq ACCURACY AT:CURVE->POLY-ACCURACY)
  (if (= 'ENAME (type en))
    (progn (setq el (entget en)
en (vlax-ename->vla-object en)
  )
    )
    (progn (setq el (entget (vlax-vla-object->ename en))))
  )
  (if (and (assoc 70 el) (logand 1 (cdr (assoc 70 el))))
    (setq closedflag T)
  )
  (setq lastent (entlast))
  (if (vlax-property-available-p en 'Length)
    (setq len (vlax-get-property en 'Length))
    (progn
      (setq len (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en)))
      ;; Ellipsenbögen liefern vlax-curve-getDistAtParam = 0 aus:
      (if (= 0.0 len)
(setq len (vlax-curve-getDistAtParam en 1.0))
      )
    )
  )
  (setq vertexnumber (fix (/ len ACCURACY)))
  (if (= 0 vertexnumber)
    (setq vertexnumber 1)
  )
  (setq stparam   (vlax-curve-getstartparam en)
endparam  (vlax-curve-getendparam en)
diffparam (/ (- endparam stparam) (float vertexnumber))
startpt   (trans (vlax-curve-getStartPoint en) 0 1)
endpt   (trans (vlax-curve-getEndPoint en) 0 1)
  )
  ;; (at-deactivate-osmode)
  (command "._pline" startpt)
  (while (< (+ stparam diffparam) endparam)
    (setq stparam (+ stparam diffparam))
    (setq startpt (vlax-curve-getPointAtParam en stparam))
    (command (trans startpt 0 1))
  )
  (if (= 1 closedflag)
    (command "_cl")
    (command endpt "")
  )
  ;; (at-restore-osmode)
  (if (not (eq (entlast) lastent))
    (entlast)
  )
)

---

Die auskommentierten Funktionen zum Deaktivieren und Wiederherstellen des Objektfangs kriegst Du sicher selber hin. Ansonsten funktioniert die Funktion mit allem, was in AutoCAD als "curve" gilt. Die Auflösung wird durch AT:CURVE->POLY-ACCURACY gesteuert, die kannst Du natürlich auch gerne als Parameter mit übergeben. Und ja: die Verwendung von (command "._pline" ...) ist nicht besonders elegant. Aber das durch ENTMAKE oder andere Funktionen zu ersetzen, die dann auch reaktortauglich wären, ist ja ziemlich trivial.

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

---

Zitat:

---

Original erstellt von archtools:
warum soll diese Funktion nur mit Kreisen funktionieren? Warum nicht auch ...

---

... für 3D-Kurven? ("Ansonsten funktioniert die Funktion mit allem, was in AutoCAD als "curve" gilt." stimmt leider nicht).

Ersetzt man jedoch (command "_pline" ...) durch (command "_3dpoly" ...) - oder ein sinngleiches Konstrukt - ist die Funktion wirklich universell anwendbar. 

Jürgen

------------------
Bildung kommt nicht vom Lesen, sondern vom Nachdenken über das Gelesene. (Carl Hilty)

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

---

Zitat:

---

Original erstellt von jupa:

... für 3D-Kurven? ("Ansonsten funktioniert die Funktion mit allem, was in AutoCAD als "curve" gilt." stimmt leider nicht).

Ersetzt man jedoch (command "_pline" ...) durch (command "_3dpoly" ...) - oder ein sinngleiches Konstrukt - ist die Funktion wirklich universell anwendbar. 

---

Wie ich schon schrieb, sollte man den Aufruf (command "._pline" ...") am Ende weglassen und nur die Punktliste zurück geben lassen. Mit der kann man dann jede beliebige Funktion füttern. Hier wollte ich für Euch aber eine brauchbare Lösung anbieten.

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