Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  Volumen bestimmen

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:  Volumen bestimmen (1148 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: 08. Okt. 2012 12: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


Drawing1.dwg.txt

 
Code:

(defun c:test ( /
              obb  ; Breite der Strasse
              oby  ; Stärke Oberbau
             
              segN ; Anzahl der Segmente in der 3dPoly
              segP ; Segmentparameter
              segA ; Segmentanfangspunkt
              segE ; Segmentendpunkt
             
              vl-en; VLA entity
              en  ; entity
              edata; Elementdaten
              ss  ; Selectionset aller Geländepunkte
             
              Gpt  ; Geländepunkt
              Spt  ; Oberkante Strasse
              Mpt  ; Geländepunkt
              Tpt  ; Trassenpunkt

              Tdis ; Trassenbreite
              Mdis ; Auf- oder Abtragslänge
             
              flc  ; Abtragsfläche
              flf  ; Auftragsfläche
              cut  ; Abtragsfaktor
              fill ; Auftragsfaktor
              )
  (setvar "OSMODE" 0)
  (setq obb (getreal "\nWide road bed: "))
  (setq oby (getreal "\nThickness road bed: "))
  ;; wähle eine 3dPolylinie und setze auf die Vertex den entspr. Höhentext
  (if (= (cdr (assoc 0 (entget (setq en (car (entsel "\nSelect Polyline ")))))) "POLYLINE")
    (progn
      (setq segN (abs (fix (vlax-curve-getendparam en)))) ; number of segments
      (setq vl-en (vlax-ename->vla-object en))
      (while (and (setq en (entnext en))
                  (setq edata (entget en))
                  (=(cdr(assoc 0 edata))"VERTEX")
                  (entmakex
                    (list
                      '(0 . "TEXT")
                      (assoc 10 edata)
                      (cons 40 1.0)
              (cons 1 (rtos (nth 2 (cdr (assoc 10 edata))) 2 2))
                      '(50 . 0.0)
                      '(11 0.0 0.0 0.0)
              '(210 0.0 0.0 1.0)
              '(71 . 0)'(72 . 0)'(73 . 0)
                      )
                    )
                  )
        )
      ;; wähle alle befindlige Geländepunkte
      (princ "\nSelect Blocks and Points ")
      (if (setq ss (ssget '((0 . "INSERT,POINT"))))
        (progn
          (setq I -1)
          (repeat (sslength ss)
            (setq en (ssname ss (setq I (1+ I))))
            (setq Gpt (list
                        (car (cdr (assoc 10 (entget en))))
                        (cadr (cdr (assoc 10 (entget en))))
                        (atof (cdr (assoc 1 (entget (entnext en)))))
                        )
                  )
            (setq Spt (vlax-curve-getClosestPointTo vl-en Gpt))
            (setq Mpt (list (car Spt) (cadr Spt) (caddr Gpt)))
            (setq segP (vlax-curve-getparamAtPoint vl-en Spt))
            (setq segA (vlax-curve-getpointatparam vl-en (fix segP)))
            (setq segE (vlax-curve-getpointatparam vl-en (1+ (fix segP))))
;;;            (setq segL (distance segA segE))
;;;            (setq segLa (distance segA Spt))
            (entmake
              (list
                (cons 0 "LINE")
        (cons 8 (getvar "CLAYER"))
        (cons 10 Gpt)
                (cons 11 Spt)
                )
              )
            ;; Berechnet die Auf- oder Abtragsflächen
            (if (minusp (_calcCoF Mpt Spt))
              (progn
                (setq Tdis (+ obb (* 2 oby)))
                (setq Mdis (+ (* (* cut 0.25) 2) Tdis))
                (setq flc (* (/ (+ Tdis Mdis) 2) cut))
                )
              (progn
                (setq Tdis (+ obb (* 2 oby)))
                (setq Mdis (+ (* fill 2) Tdis))
                (setq flf (* (/ (+ Tdis Mdis) 2) fill))
                )
              )
            (if flf
              (progn
                    (entmake
                      (list
                        (cons 0  "MTEXT")
                        (cons 100  "AcDbEntity")
                        (cons 100 "AcDbMText")
                        (cons 10 Spt)
                        (cons 40 (getvar "TEXTSIZE"))
                        (cons 41 250)
                        (cons 1 (strcat "Fill\nArea= " (rtos flf 2 2)))
                        (cons 50 0.0)
                        )
                      )
                (setq flf nil)
                )
              )
            (if flc
              (progn
                  (entmake
                      (list
                        (cons 0  "MTEXT")
                        (cons 100  "AcDbEntity")
                        (cons 100 "AcDbMText")
                        (cons 10 Spt)
                        (cons 40 (getvar "TEXTSIZE"))
                        (cons 41 250)
                        (cons 1 (strcat "Cut\nArea= " (rtos flc 2 2)))
                        (cons 50 0.0)
                        )
                      )
                (setq flc nil)
                )
              )
           

            )
          )
        )
      )
    )
  )
;; Berechnet den Auf- oder Abtragfaktor
(defun _calcCoF (Mpt Spt / )
(setq Tpt (list (car Spt) (cadr Spt) (- (caddr  Spt) oby)))
  (if (minusp (- (caddr Tpt) (caddr Mpt)))
    (setq cut (- (caddr Tpt) (caddr Mpt)))
    (setq fill (- (caddr Tpt) (caddr Mpt)))
    )
  )


           


Ich habe hier mal ein Tool geschrieben, welches mir die Auf- und Abtragsvolumen auf einfache Art ermitteln soll.
Dabei werden bereits die Auf- und Abtragsflächen an die jeweiligen Sektionen geschrieben
Um die Volumen zu ermitteln muss ich jetzt den Abstand der Sektionen zueinander wissen um dann die Mittel der Flächen mal die Strecke zu rechnen.

Die Länge eines Segments entspricht (distance segA segE), Spt ist der Sektionspunkt der auf der Geraden segA nach segE liegt. Wie kann ich also die Strecken zwischen den einzelnen Spt auf galante Art berechen.

------------------
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: 08. Okt. 2012 18:04    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

mmmh ich rätsle noch daran wie ich die Teilstrecken zwischen den Querschnitten und Stützpunkten der Polylinie ermitteln kann

Ich bin irgendwie noch auf dem Holzweg, vielleicht hat einer eine Idee zu meinem Vorhaben

Ich bekomme ohne weiteres eine Liste mit allen Stützpunkten der 3dPolylinie
und eine weitere Liste mit allen Schnittpunkten mit der 3dPolylinie, wo ich eine Auf- oder Abtragsfläche ermittle

Wenn ich die zwei Listen geordnet so zusammenfügen kann, dass als Ergebnis rauskommt
(V...Stützpunkt Polylinie, Q... Querprofil, Schnittpunkt mit der Polylinie)

((V1 Q1 Q2 Q3 V2 Q4 Q5 V3 Q6 Q7....))

Heisst also die 3dPolylinie besteht aus 3 Vertex- und 7 Querschnittpunkten

Wäre das machbar oder ist das reiner Quatsch, vielleicht gibt es einen einfacheren Weg - ich hoffe ich hab es klarer beschrieben.


------------------
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

erstellt am: 19. Okt. 2012 08:57    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

Nochmal nachgehakt: Wenn bei einer Polylinie von A E die Teilstrecken T1 T2 T3 abrufe mit

Code:
(vlax-curve-getdistatpoint vl-en PolyLiniePkt)

dann muss ich beispielsweise für die Strecke von T1 nach T2 die Strecke von A nach T1 abziehen.

Ich komme nur in Teufels Küche bei der letzten Teilstrecke von T3 nach E.

Vom Prinzip her gehe ich so vor

Code:

(if (setq I (length Teilpunkte))
  (while (>= I 0)
    (setq dis (- (vlax-curve-getdistatpoint vl-en (nth (1+ I) Teilpunkte))
                (vlax-curve-getdistatpoint vl-en (nth I Teilpunkte))
                )
    )
  )
)

Meine Frage ist, wie deklariere ich, wenn ich das Ende der Polylinie erreicht habe ?

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

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

CADmium
Moderator
Maschinenbaukonstrukteur




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

Beiträge: 13508
Registriert: 30.11.2003

.

erstellt am: 19. Okt. 2012 09: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 Nur für cadplayer 10 Unities + Antwort hilfreich

vergleichen mit
(vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))  ???

Sorry , aber dein Code oder Vorhaben ist für mich ( nebenbei auf die Schnelle ) nicht nachvollziehbar.

------------------
Also ich finde Unities gut ...
---------------------------------------
  - 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

wronzky
Ehrenmitglied V.I.P. h.c.
CAD-Dienstleistungen für Architekten



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

Beiträge: 2154
Registriert: 02.05.2005

CAD:
AutoCAD 2.6 bis 2014
ADT 2005 - 2014
Arcibem
System:
Windows 2000, XP, NO VISTA
Internet-Startseite:
http://www.archi.de

erstellt am: 19. Okt. 2012 09: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 Nur für cadplayer 10 Unities + Antwort hilfreich

oder:
mach's mit  (vl-catch-all-error-p (vl-catch-all-apply...)) bis ein Fehler auftritt.

Grüsse, Henning

------------------
Henning Jesse
VoxelManufaktur
Computer-Dienstleistungen für Architekten und Ingenieure

  http://www.voxelman.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: 19. Okt. 2012 10:11    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 eure schnelle Rückmeldung, ich bin noch nicht allzu vertraut mit den vl-funktionen, übersehe ich etwas ich bekomme nämlich nur die Teilstrecken vom PolylinienAnfang zu den einzelnen Zwischenpunkten

Code:

(setq gesamtDis (vlax-curve-getdistatpoint vl-en (vlax-curve-getendpoint vl-en)))
          (foreach D area_list (> gesamtDis (vlax-curve-getdistatpoint vl-en (list (cadr D) (caddr D) (cadddr D))))
            (setq punktDis (vlax-curve-getdistatpoint vl-en (list (cadr D) (caddr D) (cadddr D))))
            (setq teilDis (- gesamtDis punktDis))
            (setq teil_list (cons teilDist teil_list))
            )


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

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



Entwicklungsingenieur (m/w/d) Maschinenbau
Du möchtest deine Karriereentwicklung nicht dem Zufall überlassen? Dann geh mit uns gezielt den nächsten Schritt! Die besten Köpfe für die unterschiedlichsten Aufgaben finden. Menschen und Technologien verbinden, und zwar täglich aufs Neue - dafür schätzen unsere Kunden FERCHAU. Unterstütze unseren Kunden als Entwicklungsingenieur:in im Bereich Maschinenbau!

Entwicklungsingenieur (m/w/d) ...
Anzeige ansehenMaschinenbau
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: 19. Okt. 2012 14:50    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

So könnte es vielleicht klappen, nur stimmt die Punktliste (pt_list) nicht mit dem zugefügten Endpunkt (ept) überein
weil dann würde ja der Fall T bei der letzten whil-schleife zutreffen

-----------------überarbeitet

Code:

(defun c:test ( /
      i
      pt_list
      dis
;;;       Tdis
      ept
      )
  (while
    (not
      (if (setq ent (entsel "\nWähle Polyline: "))
        (setq obj (vlax-ename->vla-object (car ent)))
        )
      )
    )
  (setq i 2)
  (while
    (>= 1
        (length
          (setq pt_list
                (cons
                  (vlax-curve-getClosestPointTo obj (getpoint (strcat "\nWähle ["(itoa (setq i (1- i)))"] Punkte: ")))
                  pt_list)
                )
          )
        )
 
    )
  (foreach N pt_list (/= pt_list nil)
    (entmake
      (list
        '(0 . "POINT")
        (cons 10 N)
        )
      )
  )
  (setq i 0)
  (setq  ept (vlax-curve-getEndPoint obj))
  (setq pt_list (append (reverse pt_list) (list ept)))
  (while (not (equal (nth i pt_list) ept 0))
    (progn
      (setq dis (- (vlax-curve-getdistatpoint obj (nth (1+ i) pt_list))
                  (vlax-curve-getdistatpoint obj (nth i pt_list))
                  )
            )
      (setq Tdis (cons dis Tdis))
      (setq i (1+ i))
      )
    )
  (princ)
  )

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

[Diese Nachricht wurde von cadplayer am 19. Okt. 2012 editiert.]

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