Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  Listen zusammenführen

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Listen zusammenführen (1919 mal gelesen)
cadplayer
Ehrenmitglied
CADniker


Sehen Sie sich das Profil von cadplayer an!   Senden Sie eine Private Message an cadplayer  Schreiben Sie einen Gästebucheintrag für cadplayer

Beiträge: 1832
Registriert: 28.04.2009

erstellt am: 24. Sep. 2012 13:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Ich habe eine Frage zu, wie ich zwei getrennte Listen nach ihren Charaker zusammenführen kann.

Als Beispiel soll sein
Eine Liste mit Bogenlängen
(("Layername" . Bogenlänge1) (.....2) (.....3))
und die zeite mit Linienlängen
(("Layername" . Linelänge1) (.....2) (.....3))

Ich hätte gern die Längen Layerweise addiert.
Meine Frage wäre wie ich die 2 Listen so zusammenführen kann, dass mir alle Längen entsprechend ihrem Layer addiert werden.

Die Summe von allen Längen ist kein Problem, wie mache ich es nur wenn ich die Summen entsprechend dem Layer aufschlüsseln will.

Code:

(if (/= (setq ss (ssget '((0 . "ARC,LINE,*POLYLINE")))) nil)
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq en (cdr (assoc -1 (entget (ssname ss i)))))
        (setq lay (cons en (cdr (assoc 8 (entget en)))))
        (setq layEn (cons lay layEn))
        (if (= (cdr (assoc 0 (entget en))) "ARC")
          (progn
            (setq sa (cdr (assoc 50 (entget en)))
                  ea (cdr (assoc 51 (entget en)))
                  arc (cdr (assoc 40 (entget en)))
                  )
            (setq al (GetArcLength ea sa arc))
            (setq ares (+ al ares))
            (setq liste1 (cons (cons (cdr lay) al) liste)) ; Liste aller Bögen
            )
          )
        (if (/= (cdr (assoc 0 (entget en))) "ARC")
          (progn
            (setq ll (_lengthOfObject en))
            (setq lres (+ ll lres))
            (setq liste2 (cons (cons (cdr lay) ll) liste)) ; Liste aller LinienObjekte
            )
          )
       
        (setq res (+ lres ares))
        (setq i (1+ i))
        )
      (princ (strcat "\n\n>>>> Total of all length: " (rtos res 2 2)))
      (princ)
      )
      )

------------------
Gruss Dirk

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

gmk
Mitglied
Dipl.-Ing.(FH) Vermessung


Sehen Sie sich das Profil von gmk an!   Senden Sie eine Private Message an gmk  Schreiben Sie einen Gästebucheintrag für gmk

Beiträge: 667
Registriert: 23.10.2002

Autocad 2004, WS CadCompass, Normica V2000, WinXP Prof., AMD Athlon 64 X2, 2GB, NVIDIA GeForce 7600GS, HP1055CM

erstellt am: 24. Sep. 2012 14:01    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für cadplayer 10 Unities + Antwort hilfreich

Servus Dirk,

Liste nach Layrenamen sortieren, solange addieren bis sich der Layername ändert, in neue Liste wegspeichern. Ergebnis= Liste mit allen Layern und entsprechenden Summen.

Ciao Georg

------------------
http://www.xxx-tausend.info

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

cadplayer
Ehrenmitglied
CADniker


Sehen Sie sich das Profil von cadplayer an!   Senden Sie eine Private Message an cadplayer  Schreiben Sie einen Gästebucheintrag für cadplayer

Beiträge: 1832
Registriert: 28.04.2009

erstellt am: 24. Sep. 2012 14:34    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Danke für den Tip Georg. Ich steh nur vorm Problem, wenn ich meine Objektliste nach den Layern sortiere fehlen mir anschliessend die Längen, oder wie kriege ich das zusammen sortiert

Bsp
oList
(("Layer1" . 20.0) ("Layer1" . 10.0) ("Layer2" . 30.0) ("Layer2" . 10.0) ("Layer4" . 10.0))

(vl-sort (mapcar 'car olist) '< ))

-> ("Layer1" "Layer1" "Layer2" "Layer2" "Layer4")

------------------
Gruss Dirk

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

CAD-Huebner
Ehrenmitglied V.I.P. h.c.
Verm.- Ing., ATC-Trainer



Sehen Sie sich das Profil von CAD-Huebner an!   Senden Sie eine Private Message an CAD-Huebner  Schreiben Sie einen Gästebucheintrag für CAD-Huebner

Beiträge: 9732
Registriert: 01.12.2003

One AutoCAD 2.5 - 2023, Civil 3D, Win10/win11

erstellt am: 24. Sep. 2012 15:25    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für cadplayer 10 Unities + Antwort hilfreich

Schaust du in die Hilfe, findest du das passende Beispiel:
http://exchange.autodesk.com/autocadmep/enu/online-help/BLDSYS/2012/ENU/pages/WS1a9193826455f5ff1a32d8d10ebc6b7ccc-687f.htm

Code:
(vl-sort '(("Layer1" . 20.0) ("Layer1" . 10.0) ("Layer2" . 30.0) ("Layer2" . 10.0) ("Layer4" . 10.0)) (function (lambda (e1 e2) (< (car e1) (car e2)))))

------------------
Mit freundlichem Gruß

Udo Hübner
www.CAD-Huebner.de

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

cadplayer
Ehrenmitglied
CADniker


Sehen Sie sich das Profil von cadplayer an!   Senden Sie eine Private Message an cadplayer  Schreiben Sie einen Gästebucheintrag für cadplayer

Beiträge: 1832
Registriert: 28.04.2009

erstellt am: 24. Sep. 2012 17:24    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Danke Udo, denke ich jetzt zu kompliziert...

Um alle Längen vom "Layer1" zu erhalten muss ich diese ersteinmal rausfiltern aus der sortierten Liste

Mein Gedanke ist jetzt, ersteinmal festzustellen welche "Layer" gibt es überhaupt
das bekomme ich raus mit der Funktion

(setq layL (_RemoveDuplicates (mapcar 'cdr layEn)))

->("Layer1" "Layer2" "Layer4")

Jetzt sage ich nimm das erste Element aus layL und suche es in meiner Suchliste

(("Layer1" . 20.0) ("Layer1" . 10.0) ("Layer2" . 30.0) ("Layer2" . 10.0) ("Layer4" . 10.0))

oder gibt es da einen einfacheren Weg der "Layer1" listen raus zu filtern und zu addieren

------------------
Gruss Dirk

[Diese Nachricht wurde von cadplayer am 24. Sep. 2012 editiert.]

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

cadffm
Moderator
良い精神




Sehen Sie sich das Profil von cadffm an!   Senden Sie eine Private Message an cadffm  Schreiben Sie einen Gästebucheintrag für cadffm

Beiträge: 21533
Registriert: 03.06.2002

Alles

erstellt am: 24. Sep. 2012 19:01    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für cadplayer 10 Unities + Antwort hilfreich

Ich werfe mal ein paar Dinge ein:

1.
Wenn du über SSGET nur ARC,LINE und *POLYLINE zulässt, dann kannst du sicher sein das:
wenn es kein ARC-Objekt ist, muß es ein Linienobjekt sein ! Somit kannst du die 2.IF-Abfrage sparen:

( if (GLEICH: en ARC-Objekt)
     (dann: ermittel wie bei Arc-Objekt nötig)
     (ansonsten: ermittel wie bei Linien-Objekt üblich)
)


2.
Du baust weder Liste1 noch Liste2 richtig auf: (setq liste1 (cons (cons (cdr lay) al) liste))
So würdest du eine Liste1 erstellen mit allen "al" Daten: (setq liste1 (cons (cons (cdr lay) al) liste1))


3.
Es ist für das Ergebnis anscheinend unerheblich ob die Länge von einem Bogen oder von einem Linienobjekt stammt,
warum führst du also zwei getrennte Listen ? oder irre ich mich bezüglich der Wichtigkeit ?
Du könntest also bei beiden (ARC und *LINE Objekt) die gleiche Liste füttern:
(setq liste (cons (cons (cdr lay) <ermittelteLänge>) liste))


4.
Wenn du Listen hättest wie du sie eigentlich derzeit erwartest:
Ich gehe davon aus das deine Listen eigentlich so aussehen sollten derzeit ?

(setq LLIST '(("L1" . 12)("L5" . 0.33)("L5" . 3)("L1" . 5)("L7" . 1.5)))

(defun LENLAY (LAYER LLIST) ; Länge pro Layer
  (apply '+ (mapcar 'cdr (vl-remove-if-not '(lambda(i)(= (strcase(car i)) (strcase LAYER)))LLIST)))
)

oder etwas gröber

(defun LENLAY (LAYER LLIST / GesLi) ; Länge pro Layer
  (setq GesLi 0)
  (foreach i LLIST
    (if (= (strcase (car i)) (strcase LAYER))
        (setq GesLi (+ (cdr i) GesLi))
    )
  )
GesLi
)

;TEST mit bekanntem Layer
(LENLAY "L1" LLIST)
==> 17

;TEST mit unbekanntem Layer
(LENLAY "kk" LLIST)
==> 0

Bei den Listen würde ich noch in Abhängigkeit dessen ob der User Layernamen eingeb darf/muss
noch besonders auf GROSS/kleinSchreibung achten beim speichern und vergleichen.

------------------
CAD.de System-Angaben  -  CAD on demand  -  User:FAQ(Acad)

[Diese Nachricht wurde von cadffm am 25. Sep. 2012 editiert.]

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

cadplayer
Ehrenmitglied
CADniker


Sehen Sie sich das Profil von cadplayer an!   Senden Sie eine Private Message an cadplayer  Schreiben Sie einen Gästebucheintrag für cadplayer

Beiträge: 1832
Registriert: 28.04.2009

erstellt am: 25. Sep. 2012 09:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Danke für deine grosse Mühe, die du mit deinen Einwürfen gemacht hast.
Ich bin soweit, dass mir einmal die Gesamtlängen aller Bögen und LinienObjekte ausgegeben wird und als zweites die Gesamtlängen von allen Objekten auf Layer1

Meine Idee jetzt an die nächste Layergruppe ranzugehen wäre, ersteinmal meine Suchliste wo alle drinstehenden Listen mit ("Layer" . LängeZahl) um die bereits ermittelten Längen aus Layer1 zu dezimieren. Das gelingt mir zum Teil, Ich weiss in LLIST stehen alle Layer1 Objekte -> nur bekomme ich die nicht in eine Variable gespeichert. Weil dann könnte ich mit der folgenden Funktion alle Layer1Objekte aus der Suchliste (sList) rauslöschen

(setq sList (vl-remove-if '(lambda (x) (car (member x LLIST))) sList))

------------------
Gruss Dirk

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

CAD-Huebner
Ehrenmitglied V.I.P. h.c.
Verm.- Ing., ATC-Trainer



Sehen Sie sich das Profil von CAD-Huebner an!   Senden Sie eine Private Message an CAD-Huebner  Schreiben Sie einen Gästebucheintrag für CAD-Huebner

Beiträge: 9732
Registriert: 01.12.2003

One AutoCAD 2.5 - 2023, Civil 3D, Win10/win11

erstellt am: 25. Sep. 2012 10:24    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für cadplayer 10 Unities + Antwort hilfreich

Um eine Vorstellung vom eigenlichen Ziel zuu bekommen - die Längen der Bögen und Linien sollen getrennt pro Layer summiert werden - was ist dann mit den Bögen in Polylinien?
Würdest du dir dein Programm nicht übersichtlicher gestalten, wenn du vla-length zur Längenermittlung von Linien, Bögen und Polylinien verwendest?

Hier mal ähnliche Beispiele
http://www.jtbworld.com/lisp/bomlengths.htm

------------------
Mit freundlichem Gruß

Udo Hübner
www.CAD-Huebner.de

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

gmk
Mitglied
Dipl.-Ing.(FH) Vermessung


Sehen Sie sich das Profil von gmk an!   Senden Sie eine Private Message an gmk  Schreiben Sie einen Gästebucheintrag für gmk

Beiträge: 667
Registriert: 23.10.2002

Autocad 2004, WS CadCompass, Normica V2000, WinXP Prof., AMD Athlon 64 X2, 2GB, NVIDIA GeForce 7600GS, HP1055CM

erstellt am: 25. Sep. 2012 10:47    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für cadplayer 10 Unities + Antwort hilfreich

Mein Vorschlag:

Geometrien codieren 1=Linie 2=Bogen 3=Polylinie usw.
'((Layer1 1 15.20) (Layer3 2 2.50) (Layer5 3 10.20) (Layer2 1 5.20) usw)

2x VL-SORT, dann ist die Liste nach Layern und Geometrien sortiert.

Dann FOREACH mit der sortierten Liste ; wenn sich Layer oder Geometrie zum Listenvorgänger ändert Summe in neue Liste wegspeichern.

Ciao Georg

------------------
http://www.xxx-tausend.info

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

cadplayer
Ehrenmitglied
CADniker


Sehen Sie sich das Profil von cadplayer an!   Senden Sie eine Private Message an cadplayer  Schreiben Sie einen Gästebucheintrag für cadplayer

Beiträge: 1832
Registriert: 28.04.2009

erstellt am: 25. Sep. 2012 12:56    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Die Vorschläge sind gut, aber ersteinmal der Reihe nach. Du hast recht Udo, die option, dass Bögen in Polylinien enthalten sind muss mit berücksichtigt werden.

mit cond muss das gehen

(cond ((= (cdr (assoc 0 (entget en))) "ARC") ... filter ich alle Bögen

      ((and (cdr (assoc 0 (entget en))) "LINE") ... filter ich alle Linien

Frage: wie kann ich dann sagen, das 5 Objekte keine Bögen oder Linien waren (vermutlich simples Rezept ich komm nur nicht drauf)
            


Eins noch Udo, die Längen von Bögen und Linien sind auch in deinem Beispiel getrennt voneinander gerechnet, da vla-get-length nur bei Linienobjekten greift.
vla-length gibt es meines Erachtens gar nicht!

[Diese Nachricht wurde von cadplayer am 25. Sep. 2012 editiert.]

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

gmk
Mitglied
Dipl.-Ing.(FH) Vermessung


Sehen Sie sich das Profil von gmk an!   Senden Sie eine Private Message an gmk  Schreiben Sie einen Gästebucheintrag für gmk

Beiträge: 667
Registriert: 23.10.2002

Autocad 2004, WS CadCompass, Normica V2000, WinXP Prof., AMD Athlon 64 X2, 2GB, NVIDIA GeForce 7600GS, HP1055CM

erstellt am: 25. Sep. 2012 13:21    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für cadplayer 10 Unities + Antwort hilfreich

Mei, Dirk, des is imma des gleiche mid dia !!

Zuerst einen Plan entwickeln und dann programmieren. Nicht immer andersrum.

Wie könnte man denn bei einer Polylinie rauskriegen ob ein Segment ein Bogen oder eine Gerade ist? Mit COND allein  bestimmt nicht ... Evtl. probierst es mal mit den simplen Gruppencodes. Dann findest u.U. den 42er. Das ist nämlich die Krümmung aus der Du den Radius berechnen kannst, aber mehr sag' ich Dir jetzt nimma weil Du nur was lernst wennst auch mal eine Lösung selbst erarbeiten mußt.
Nur noch ein Tipp: Mach Dir doch mal eine eigene Bibliothek, da kannst Du dann so Sachen wie "eine Poylinie in ihre Einzelelemente zerlegen" ablegen. Brauchst bestimmt in Zukunft noch öfters.

Ciao Georg

------------------
http://www.xxx-tausend.info

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

cadplayer
Ehrenmitglied
CADniker


Sehen Sie sich das Profil von cadplayer an!   Senden Sie eine Private Message an cadplayer  Schreiben Sie einen Gästebucheintrag für cadplayer

Beiträge: 1832
Registriert: 28.04.2009

erstellt am: 25. Sep. 2012 14:01    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Äh Georg, du hast es glaub ich falsch aufgefasst. Ich will generell keine Polylinien mehr im AWS haben. Nur möchte ich gern das die Routine merkt das wenn Polylinien, Ellipsen, Splines dergleichen im AWS hängen, dass die bei der Auswertung nicht berücksichtigt sind.

Ich denke meine Aufgabenstellung ist klar.

1 Funktion zur Ermittlung der Längen von Linien - erledigt
2 Funktion zur Ermittlung der Längen von Bögen - erledigt
3 Auswahlsatz der Längen von Linien und Bögen unter Berücksichtigung auf welchen Layer das Objekt liegt - erledigt

Weiter zu tun habe ich mit

4 Aussage wenn Splines, Ellipsen, Polylinien im AWS sind, dann sage bspw. "5 Objekte waren keine Linien oder Bögen"
5 Das erste Zwischenergebnis habe ich von den Längen im ersten Layer, die Frage war jetzt: ich möchte gern das Zwischenergebnis vom      nächsten Layer in der Suchliste haben. Muss ich vorher, die bereits berechneten Längen mit Layern rauslöschen ?

Ich hoffe es ist jetzt vielleicht deutlicher wo ich bin und wo ich hin will


------------------
Gruss Dirk

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

gmk
Mitglied
Dipl.-Ing.(FH) Vermessung


Sehen Sie sich das Profil von gmk an!   Senden Sie eine Private Message an gmk  Schreiben Sie einen Gästebucheintrag für gmk

Beiträge: 667
Registriert: 23.10.2002

Autocad 2004, WS CadCompass, Normica V2000, WinXP Prof., AMD Athlon 64 X2, 2GB, NVIDIA GeForce 7600GS, HP1055CM

erstellt am: 25. Sep. 2012 14:44    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für cadplayer 10 Unities + Antwort hilfreich

(SETQ li '(("Layer1" 1 15.20) ("Layer3" 2 2.50) ("Layer5" 3 10.20) ("Layer2" 1 5.20) ("Layer3" 1 15.20) ("Layer2" 2 2.50)
  ("Layer3" 3 10.20) ("Layer1" 1 5.20) ("Layer1" 1 15.20) ("Layer1" 2 2.50) ("Layer3" 3 10.20) ("Layer3" 1 5.20)))


(DEFUN laengen (
li
/
layer
code
summe
erg
)    


(SETQ li (vl-sort (vl-sort li (function (lambda (e1 e2) (< (NTH 1 e1) (NTH 1 e2))))) (function (lambda (e1 e2) (< (NTH 0 e1) (NTH 0 e2))))))
(SETQ layer (NTH 0 (NTH 0 li)))
(SETQ code (NTH 1 (NTH 0 li)))
(SETQ summe (NTH 2 (NTH 0 li)))
(SETQ erg nil) 
(FOREACH n (CDR li)
  (IF (AND (= (NTH 0 n) layer) (= (NTH 1 n) code))
    (SETQ summe (+ summe (NTH 2 n)))
    (PROGN
      (SETQ erg (CONS (LIST layer code summe) erg))
      (SETQ layer (NTH 0 n))
      (SETQ code (NTH 1 n))
      (SETQ summe (NTH 2 n))
    ) 
  )                                             
)
(REVERSE (CONS (LIST layer code summe) erg)) 
)

Rückgabewert
(("Layer1" 1 35.6) ("Layer1" 2 2.5) ("Layer2" 1 5.2) ("Layer2" 2 2.5) ("Layer3"
1 20.4) ("Layer3" 2 2.5) ("Layer3" 3 20.4) ("Layer5" 3 10.2))

------------------
http://www.xxx-tausend.info

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

cadplayer
Ehrenmitglied
CADniker


Sehen Sie sich das Profil von cadplayer an!   Senden Sie eine Private Message an cadplayer  Schreiben Sie einen Gästebucheintrag für cadplayer

Beiträge: 1832
Registriert: 28.04.2009

erstellt am: 25. Sep. 2012 16:25    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Danke Georg für die Mühe - versteht sich, dass es Punkte gibt auch wenn ich deine Lösung als eine Fortsetzung auf meine nächste Aufgabe sehe, nänlich noch die Radien der Bögen mit auszulesen.
Nachdem ich wiedermal hü&hey alles gefragt habe, war es viel Schweiss gekostet, es doch so hinzuzaubern wie jetzt. Ich bin natürlich gern für jede Anregung offen.

Danke an alle!

Code:

; question or ideas to my program
; contact me cadplayer@gmail.com!

(defun c:sl ( /
              i    ; increment
              z    ; increment
              en  ; entity
              lay  ; assoclist (entity . layer)

              sa  ;start angle
              ea  ;end angle
              arc  ;arc radius
           
              al  ; length from arc object
              ll ; length from line object

              ares ; Summe aller Bogenlängen
              lres ; Summe aller Linienlängen

              slist ; Suchliste aller Layer mit Längen der Linien und Bögen
              llist ; Liste mit den zugehörigen Längen zu einem Layer
              erg  ; Ergebnis der Längen eines Layers

              )
  (setvar "CMDECHO" 0)
  (setq al 0
        ll 0
        ares 0
        lres 0
        res 0
        )
  (prompt (strcat "\nTool to calculate length from lines" "\nSelect lines! "))
  (if (setq ss (ssget))
    (progn
      (setq i 0
            z 0)
      (repeat (sslength ss)
        (setq en (cdr (assoc -1 (entget (ssname ss i)))))
        (setq lay (cons en (cdr (assoc 8 (entget en)))))
        (cond
          ((= (cdr (assoc 0 (entget en))) "ARC")
          (progn
            (setq sa (cdr (assoc 50 (entget en)))
                  ea (cdr (assoc 51 (entget en)))
                  arc (cdr (assoc 40 (entget en)))
                  )
            (setq al (GetArcLength ea sa arc))
            (setq ares (+ al ares))
            (setq slist (cons (cons (cdr lay) al) slist)) ; Liste aller Bögen
            )
          )
          ((= (cdr (assoc 0 (entget en))) "LINE")
            (progn
            (setq ll (_lengthOfObject en))
            (setq lres (+ ll lres))
            (setq slist (cons (cons (cdr lay) ll) slist)) ; Liste aller LinienObjekte
            )
          )
          (T
          (setq z (1+ z))
          )
          )
        (setq res (+ lres ares))
        (setq i (1+ i))
        )
      (princ (strcat "\n\n>>>> Total of all length: " (rtos res 2 2)))
      (princ (strcat "\n" (itoa z) " Object[s] not line or arc!"))
      (_layerres)
      (princ)
      )
    )
  )

; results from length of all layerObjects
(defun _layerres ( / )
  (if (setq slist (vl-sort slist (function (lambda (e1 e2) (< (car e1) (car e2))))))
    (while (/= slist nil)
      (progn
        (setq erg (_lenlay2 (setq layer (caar slist)) slist))
        (princ (strcat "\n\nLayer: " layer "\nTotal length: " (rtos erg 2 2)))
        (setq LList (vl-remove-if-not '(lambda(i) (= (strcase(car i)) (strcase LAYER))) slist))
        (setq sList (vl-remove-if '(lambda (x) (car (member x LLIST))) sList))
        (princ)
        )
      )
    )
  (princ)
  )
 
; calculate line object length
(defun _lengthOfObject (en / curve area)
(vla-get-length(vlax-ename->vla-object en))
  )


; Calculate the ARC's length:
(defun GetArcLength (END_ANG START_ANG ARC_RAD / TOTAL_ANG)
  (setq TOTAL_ANG (- END_ANG START_ANG))
  (while (< TOTAL_ANG 0)
    (setq TOTAL_ANG (+ TOTAL_ANG (* 2 pi)))
    )
  (while (> TOTAL_ANG (* 2 pi))
    (setq TOTAL_ANG (- TOTAL_ANG (* 2 pi)))
    )
  (* (* 2 pi ARC_RAD) (/ TOTAL_ANG (* 2 pi)))
  )

; Sucht in Liste zugehörige Layer mit Längen nach cadffm
; 1. Möglichkeit
(defun _LENLAY (LAYER sLIST / GesLi)
  (setq GesLi 0)
  (foreach i sLIST
    (if (= (strcase (car i)) (strcase LAYER))
      (setq GesLi (+ (cdr i) GesLi))
      )
    )
  GesLi
  )
; 2. Möglichkeit um zugehörige Layer mit Längen zu filtern
(defun _LENLAY2 (LAYER LLIST)
  (apply '+
        (mapcar 'cdr
                (vl-remove-if-not
                  '(lambda(i) (= (strcase(car i)) (strcase LAYER)))
                  LLIST)
                )
        )
  )



------------------
Gruss Dirk

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

cadplayer
Ehrenmitglied
CADniker


Sehen Sie sich das Profil von cadplayer an!   Senden Sie eine Private Message an cadplayer  Schreiben Sie einen Gästebucheintrag für cadplayer

Beiträge: 1832
Registriert: 28.04.2009

Windows 10
64bit system
Autocad Civil3d 2020 ENGLISH
Visual Studio 2019
OpenDCL.Runtime.9<P>

erstellt am: 26. Sep. 2012 12:22    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Keine Beanstandungen, welch ein Wunder!

------------------
Gruss Dirk

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz