Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Rund um AutoCAD
  LISP ändern

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:  LISP ändern (1477 mal gelesen)
SNOOP_69
Mitglied
Konstrukteur - Innenausbau


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

Beiträge: 541
Registriert: 25.01.2006

Hardware:
- Lenovo-W540
Software:
- Win10 Pro 64bit
- Autocad 2018-2023 (Vollversion+LT)
- BricsCad
- DraftSight
- SolidWorks 2017-2022
- SWOOD 2019
- MasterCAM 2018-2022

erstellt am: 24. Jul. 2019 08: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

Hallo zusammen,
kann mir jemand kurz helfen?!
Ich habe das nachfolgende LISP im Internet gefunden und würde es gerne ändern, mir fehlen jedoch die Fähigkeiten.
Das Lisp liest Flächen und Längen aus gewählten Objekten aus und setzt diese dann als Text in die Zeichnung.
Ich hätte die Flächen und Längen gerne von Millimeter auf Meter geändert, geht das?

Code:
(defun C:FLAE-LAE-KALK ( / clay echo ss ant fläche z laength obj data plist pk )
  (vl-load-com)
  (setvar "textsize" 50)
  (setq clay (getvar "clayer")
        echo (getvar "cmdecho")
        ) ;_ end of setq
                                        ; Eingabe
  (princ "\n Polylinien wählen <Enter für alle Polylinien>: ")
  (setq ss (ssget '((0 . "LWPOLYLINE")
                    (70 . 1)
                    )
                  ) ;_ end of ssget
        ) ;_ end of setq
  (if (not ss)
    (progn
      (initget "Alle Layer Objekt")
      (setq ant
            (getkword
              "\n Alle, auf aktuellen Layer oder auf Objekt layer: [Alle/Layer/Objekt]: "
              ) ;_ end of getkword
            ) ;_ end of setq
      (cond
        ((= ant "Alle")
        (setq ss (ssget "X"
                        '((0 . "LWPOLYLINE")
                          (70 . 1)
                          )
                        ) ;_ end of ssget
              ) ;_ end of setq
        )
        ((= ant "Layer")
        (setq ss (ssget "X"
                        (list
                          '(0 . "LWPOLYLINE")
                          '(70 . 1)
                          (cons 8 (getvar "clayer"))
                          ) ;_ end of list
                        ) ;_ end of ssget
              ) ;_ end of setq
        )
        ((= ant "Objekt")
        (setvar
          "clayer"
          (cdr (assoc 8 (entget (car (entsel "\n Objekt wählen: ")))))
          ) ;_ end of setvar
        (setq ss (ssget "X"
                        (list
                          '(0 . "LWPOLYLINE")
                          '(70 . 1)
                          (cons 8 (getvar "clayer"))
                          ) ;_ end of list
                        ) ;_ end of ssget
              ) ;_ end of setq
        )
        ) ;_ end of cond
      ) ;_ end of progn
    ) ;_ end of if
                                        ; Berechnung
  (if (not ss)
    (princ "\n Keine Polylinien gefunden!")
    (progn
      (setq fläche 0
            laength 0
            z -1
            ) ;_ end of setq
      (repeat (sslength ss)
        (setq obj  (ssname ss (setq z (1+ z)))
              data (entget obj)
              ) ;_ end of setq
                                        ; Schwerpunkt berechnen
        (setq plist (apply
                      'append
                      (mapcar
                        '(lambda (x)
                          (if (= 10 (car x))
                            (list (cdr x))
                            ) ;_ end of if
                          ) ;_ end of lambda
                        data
                        ) ;_ end of mapcar
                      ) ;_ end of apply
              pk    (list (/ (apply '+ (mapcar 'car plist)) (length plist))
                          (/ (apply '+ (mapcar 'cadr plist)) (length plist))
                          ) ;_ end of list
              ) ;_ end of setq
        (command "_area" "Objekt" obj)
                                        ; Text setzen
        (entmake (list
                  '(0 . "TEXT")
                  (cons 1 (strcat (rtos (getvar "area") 2 2) "mm²"))
                  (cons 8 (getvar "clayer"))
                  (cons 10 pk)
                  (cons 40 (getvar "textsize"))
                  '(50 . 0.0)
                  ) ;_ end of list
                ) ;_ end of entmake
        (entmake (list
                  '(0 . "TEXT")
                  (cons 1 (strcat (rtos (vla-get-length (vlax-ename->vla-object obj)) 2 2) "mm"))
                  (cons 8 (getvar "clayer"))
                  (cons 10 (list (car pk)(-(cadr pk)(getvar "textsize"))0.0))
                  (cons 40 (getvar "textsize"))
                  '(50 . 0.0)
                  ) ;_ end of list
                )
        (setq laength(+ laength(vla-get-length (vlax-ename->vla-object obj))))
        (setq fläche (+ fläche (getvar "area")))
        ) ;_ end of repeat
      (entmake
        (list
          '(0 . "TEXT")
          (cons 1 (strcat "Gesamtfläche: " (rtos fläche 2 2) "mm²"))
          (cons 8 (getvar "clayer"))
          (cons 10 (setq txtpt(getpoint "\nEinfügungspunkt angeben: ")))
          (cons 40 (getvar "textsize"))
          '(50 . 0.0)
          ) ;_ end of list
        ) ;_ end of entmake
      (entmake
        (list
          '(0 . "TEXT")
          (cons 1 (strcat "Gesamtlänge: " (rtos laength 2 2) "mm"))
          (cons 8 (getvar "clayer"))
          (cons 10 (list (car txtpt)(-(cadr txtpt)(getvar "textsize"))0.0))
          (cons 40 (getvar "textsize"))
          '(50 . 0.0)
          ) ;_ end of list
        )
      ) ;_ end of progn
    ) ;_ end of if
  (setvar "clayer" clay)
  (setvar "cmdecho" echo)
  (princ
    (strcat "\n* Gesamtfläche beträgt: " (rtos fläche 2 2) "mm²")
    ) ;_ end of princ
  (princ)
  ) ;_ end of defun

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: 21597
Registriert: 03.06.2002

System: F1
und Google

erstellt am: 24. Jul. 2019 08: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 SNOOP_69 10 Unities + Antwort hilfreich

(rtos WASAUCHIMMER 2 2)

macht aus einer Zahl einen Zeichenkette(Text)

Fläche mm² zu m² ist einfach ein 1000000stel?
(/ flächenwert 1000000)

Länge mm zu m ist wohl einfach den Wert durch 1000 teilen?
(/ längenwert 1000) ; laength ist ja mal echt cool


Ohne den Rest des Codes zu überprüfen würde ich es schnell mal umschreiben, aber erst
wenn du dafür den angefangenen Threa zu den Werkzeugkästen fortführst? => Klick!

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: 21597
Registriert: 03.06.2002

System: F1
und Google

erstellt am: 24. Jul. 2019 08:31    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 SNOOP_69 10 Unities + Antwort hilfreich

Test diese Version

Code:
(defun C:FLAE-LAE-KALK-M ( / clay echo ss ant fläche z laength obj data plist pk )
(vl-load-com)
(setvar "textsize" 50)
(setq clay (getvar "clayer")
echo (getvar "cmdecho")
) ;_ end of setq
; Eingabe
(princ "\nPolylinien wählen <Enter für alle Polylinien>: ")
(setq ss (ssget '((0 . "LWPOLYLINE")
(70 . 1)
)
) ;_ end of ssget
) ;_ end of setq
(if (not ss)
(progn
(initget "Alle Layer Objekt")
(setq ant
(getkword
"\nAlle, auf aktuellen Layer oder auf Objekt layer: [Alle/Layer/Objekt]: "
) ;_ end of getkword
) ;_ end of setq
(cond
((= ant "Alle")
(setq ss (ssget "_X"
'((0 . "LWPOLYLINE")
(70 . 1)
)
) ;_ end of ssget
) ;_ end of setq
)
((= ant "Layer")
(setq ss (ssget "X"
(list
'(0 . "LWPOLYLINE")
'(70 . 1)
(cons 8 (getvar "clayer"))
) ;_ end of list
) ;_ end of ssget
) ;_ end of setq
)
((= ant "Objekt")
(setvar
"clayer"
(cdr (assoc 8 (entget (car (entsel "\nObjekt wählen: ")))))
) ;_ end of setvar
(setq ss (ssget "X"
(list
'(0 . "LWPOLYLINE")
'(70 . 1)
(cons 8 (getvar "clayer"))
) ;_ end of list
) ;_ end of ssget
) ;_ end of setq
)
) ;_ end of cond
) ;_ end of progn
) ;_ end of if
; Berechnung
(if (not ss)
(princ "\nKeine Polylinien gefunden!")
(progn
(setq fläche 0
laength 0
z -1
) ;_ end of setq
(repeat (sslength ss)
(setq obj (ssname ss (setq z (1+ z)))
data (entget obj)
) ;_ end of setq
; Schwerpunkt berechnen
(setq plist (apply
'append
(mapcar
'(lambda (x)
(if (= 10 (car x))
(list (cdr x))
) ;_ end of if
) ;_ end of lambda
data
) ;_ end of mapcar
) ;_ end of apply
pk (list (/ (apply '+ (mapcar 'car plist)) (length plist))
(/ (apply '+ (mapcar 'cadr plist)) (length plist))
) ;_ end of list
) ;_ end of setq
(command "_area" "Objekt" obj)
; Text setzen
(entmake (list
'(0 . "TEXT")
(cons 1 (strcat (rtos (/(getvar "area")1000000) 2 2) "m²"))
(cons 8 (getvar "clayer"))
(cons 10 pk)
(cons 40 (getvar "textsize"))
'(50 . 0.0)
) ;_ end of list
) ;_ end of entmake
(entmake (list
'(0 . "TEXT")
(cons 1 (strcat (rtos (/(vla-get-length (vlax-ename->vla-object obj))1000) 2 2) "m"))
(cons 8 (getvar "clayer"))
(cons 10 (list (car pk)(-(cadr pk)(getvar "textsize"))0.0))
(cons 40 (getvar "textsize"))
'(50 . 0.0)
) ;_ end of list
)
(setq laength(+ laength (/(vla-get-length (vlax-ename->vla-object obj))1000)))
(setq fläche (+ fläche (/(getvar "area")1000)))
) ;_ end of repeat
(entmake
(list
'(0 . "TEXT")
(cons 1 (strcat "Gesamtfläche: " (rtos fläche 2 2) "m²"))
(cons 8 (getvar "clayer"))
(cons 10 (setq txtpt(getpoint "\nEinfügungspunkt angeben: ")))
(cons 40 (getvar "textsize"))
'(50 . 0.0)
) ;_ end of list
) ;_ end of entmake
(entmake
(list
'(0 . "TEXT")
(cons 1 (strcat "Gesamtlänge: " (rtos laength 2 2) "m"))
(cons 8 (getvar "clayer"))
(cons 10 (list (car txtpt)(-(cadr txtpt)(getvar "textsize"))0.0))
(cons 40 (getvar "textsize"))
'(50 . 0.0)
) ;_ end of list
)
) ;_ end of progn
) ;_ end of if
(setvar "clayer" clay)
(setvar "cmdecho" echo)
(princ
(strcat "\n* Gesamtfläche beträgt: " (rtos fläche 2 2) "m²")
) ;_ end of princ
(princ)
) ;_ end of defun

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

SNOOP_69
Mitglied
Konstrukteur - Innenausbau


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

Beiträge: 541
Registriert: 25.01.2006

Hardware:
- Lenovo-W540
Software:
- Win10 Pro 64bit
- Autocad 2018-2023 (Vollversion+LT)
- BricsCad
- DraftSight
- SolidWorks 2017-2022
- SWOOD 2019
- MasterCAM 2018-2022

erstellt am: 24. Jul. 2019 09:15    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

Super!! Vielen Dank!
Ich habs noch ein bisschen getunt und die Laength zur Laenge gemacht ;-))
Vielen Dank!!!

Anbei meine finale Version...falls das sonst noch jemand gebrauchen kann:

Code:
(defun C:FLAE-LAE-KALK-M ( / clay echo ss ant flaeche z laenge obj data plist pk )
(vl-load-com)
(setvar "textsize" 200)
(setq clay (getvar "clayer")
echo (getvar "cmdecho")
) ;_ end of setq
; Eingabe
(princ "\nPolylinien waehlen <Enter für alle Polylinien>: ")
(setq ss (ssget '((0 . "LWPOLYLINE")
(70 . 1)
)
) ;_ end of ssget
) ;_ end of setq
(if (not ss)
(progn
(initget "Alle Layer Objekt")
(setq ant
(getkword
"\nAlle, auf aktuellen Layer oder auf Objekt layer: [Alle/Layer/Objekt]: "
) ;_ end of getkword
) ;_ end of setq
(cond
((= ant "Alle")
(setq ss (ssget "_X"
'((0 . "LWPOLYLINE")
(70 . 1)
)
) ;_ end of ssget
) ;_ end of setq
)
((= ant "Layer")
(setq ss (ssget "X"
(list
'(0 . "LWPOLYLINE")
'(70 . 1)
(cons 8 (getvar "clayer"))
) ;_ end of list
) ;_ end of ssget
) ;_ end of setq
)
((= ant "Objekt")
(setvar
"clayer"
(cdr (assoc 8 (entget (car (entsel "\nObjekt waehlen: ")))))
) ;_ end of setvar
(setq ss (ssget "X"
(list
'(0 . "LWPOLYLINE")
'(70 . 1)
(cons 8 (getvar "clayer"))
) ;_ end of list
) ;_ end of ssget
) ;_ end of setq
)
) ;_ end of cond
) ;_ end of progn
) ;_ end of if
; Berechnung
(if (not ss)
(princ "\nKeine Polylinien gefunden!")
(progn
(setq flaeche 0
laenge 0
z -1
) ;_ end of setq
(repeat (sslength ss)
(setq obj (ssname ss (setq z (1+ z)))
data (entget obj)
) ;_ end of setq
; Schwerpunkt berechnen
(setq plist (apply
'append
(mapcar
'(lambda (x)
(if (= 10 (car x))
(list (cdr x))
) ;_ end of if
) ;_ end of lambda
data
) ;_ end of mapcar
) ;_ end of apply
pk (list (/ (apply '+ (mapcar 'car plist)) (length plist))
(/ (apply '+ (mapcar 'cadr plist)) (length plist))
) ;_ end of list
) ;_ end of setq
(command "_area" "Objekt" obj)
; Text setzen
(entmake (list
'(0 . "TEXT")
(cons 1 (strcat (rtos (/(getvar "area")1000000) 2 2) "m²"))
(cons 8 (getvar "clayer"))
(cons 10 pk)
(cons 40 (getvar "textsize"))
'(50 . 0.0)
) ;_ end of list
) ;_ end of entmake
(entmake (list
'(0 . "TEXT")
(cons 1 (strcat (rtos (/(vla-get-length (vlax-ename->vla-object obj))1000) 2 2) "lfm"))
(cons 8 (getvar "clayer"))
(cons 10 (list (car pk)(-(cadr pk)(getvar "textsize"))0.0))
(cons 40 (getvar "textsize"))
'(50 . 0.0)
) ;_ end of list
)
(setq laenge(+ laenge (/(vla-get-length (vlax-ename->vla-object obj))1000)))
(setq flaeche (+ flaeche (/(getvar "area")1000000)))
) ;_ end of repeat
(entmake
(list
'(0 . "TEXT")
(cons 1 (strcat "Gesamtfläche: " (rtos flaeche 2 2) "m²"))
(cons 8 (getvar "clayer"))
(cons 10 (setq txtpt(getpoint "\nEinfügungspunkt angeben: ")))
(cons 40 (getvar "textsize"))
'(50 . 0.0)
) ;_ end of list
) ;_ end of entmake
(entmake
(list
'(0 . "TEXT")
(cons 1 (strcat "Gesamtlänge: " (rtos laenge 2 2) "lfm"))
(cons 8 (getvar "clayer"))
(cons 10 (list (car txtpt)(-(cadr txtpt)(getvar "textsize"))0.0))
(cons 40 (getvar "textsize"))
'(50 . 0.0)
) ;_ end of list
)
) ;_ end of progn
) ;_ end of if
(setvar "clayer" clay)
(setvar "cmdecho" echo)
(princ
(strcat "\n* Gesamtfläche betraegt: " (rtos flaeche 2 2) "m²")
) ;_ end of princ
(princ)
) ;_ end of defun

[Diese Nachricht wurde von SNOOP_69 am 24. Jul. 2019 editiert.]

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

WNJT
Mitglied


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

Beiträge: 3
Registriert: 12.04.2023

AutoCad 2020

erstellt am: 12. Apr. 2023 12:45    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 SNOOP_69 10 Unities + Antwort hilfreich

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


Hallo,
Dieses Tool ist super!
könnte man anstelle der Polyline auch eine Region oder Schraffur auswählen?
Ich habe Zahlreiche Teile mit Aussparungen in einer Zeichnung, von denen ich die m² und den Umfang angeben müsste.

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

Andreas Kraus
Mitglied
Elektrotechniker


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

Beiträge: 1380
Registriert: 11.01.2006

Win 10
ACAD 2022

erstellt am: 12. Apr. 2023 15: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 SNOOP_69 10 Unities + Antwort hilfreich

Grundsätzlich schon.
Wahrscheinlich möchtest du dann für die Länge jeweils den Umfang von Region bzw. Schraffur.
Die beiden haben nämlich nicht die Eigenschaft "Länge" und das muss dann separat ermittelt werden, ist aber kein Problem.

Ich setz mich nachher mal dran.

------------------
Geht nicht, gibts nicht

Gruß
Andreas

http://kraus-cad.de

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

WNJT
Mitglied


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

Beiträge: 3
Registriert: 12.04.2023

AutoCad 2020

erstellt am: 12. Apr. 2023 16:41    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 SNOOP_69 10 Unities + Antwort hilfreich

Ja genau, ich würde dann den Umfang benötigen.
Ich kenne mich mit Lisp nicht wirklich aus. Hatte es mal folgendermaßen versucht, bekomme dann allerdings diese Fehlermeldung:
; Fehler: Division durch 0
Bei Länge habe ich (getvar "perimeter") eingesetzt.

(defun C:FLAE-LAE-KALK-M_4 ( / clay echo ss ant flaeche z laenge obj data plist pk )
(vl-load-com)
(setvar "textsize" 200)
(setq clay (getvar "clayer")
echo (getvar "cmdecho")
) ;_ end of setq
; Eingabe
(princ "\nPolylinien waehlen <Enter für alle Polylinien>: ")
(setq ss (ssget '((0 . "REGION")
(70 . 1)
)
) ;_ end of ssget
) ;_ end of setq
(if (not ss)
(progn
(initget "Alle Layer Objekt")
(setq ant
(getkword
"\nAlle, auf aktuellen Layer oder auf Objekt layer: [Alle/Layer/Objekt]: "
) ;_ end of getkword
) ;_ end of setq
(cond
((= ant "Alle")
(setq ss (ssget "_X"
'((0 . "REGION")
(70 . 1)
)
) ;_ end of ssget
) ;_ end of setq
)
((= ant "Layer")
(setq ss (ssget "X"
(list
'(0 . "REGION")
'(70 . 1)
(cons 8 (getvar "clayer"))
) ;_ end of list
) ;_ end of ssget
) ;_ end of setq
)
((= ant "Objekt")
(setvar
"clayer"
(cdr (assoc 8 (entget (car (entsel "\nObjekt waehlen: ")))))
) ;_ end of setvar
(setq ss (ssget "X"
(list
'(0 . "REGION")
'(70 . 1)
(cons 8 (getvar "clayer"))
) ;_ end of list
) ;_ end of ssget
) ;_ end of setq
)
) ;_ end of cond
) ;_ end of progn
) ;_ end of if
; Berechnung
(if (not ss)
(princ "\nKeine Polylinien gefunden!")
(progn
(setq flaeche 0
laenge 0
z -1
) ;_ end of setq
(repeat (sslength ss)
(setq obj (ssname ss (setq z (1+ z)))
data (entget obj)
) ;_ end of setq
; Schwerpunkt berechnen
(setq plist (apply
'append
(mapcar
'(lambda (x)
(if (= 10 (car x))
(list (cdr x))
) ;_ end of if
) ;_ end of lambda
data
) ;_ end of mapcar
) ;_ end of apply
pk (list (/ (apply '+ (mapcar 'car plist)) (length plist))
(/ (apply '+ (mapcar 'cadr plist)) (length plist))
) ;_ end of list
) ;_ end of setq
(command "_area" "Objekt" obj)
; Text setzen
(entmake (list
'(0 . "TEXT")
(cons 1 (strcat (rtos (/(getvar "area")1000000) 2 2) "m²"))
(cons 8 (getvar "clayer"))
(cons 10 pk)
(cons 40 (getvar "textsize"))
'(50 . 0.0)
) ;_ end of list
) ;_ end of entmake
(entmake (list
'(0 . "TEXT")
(cons 1 (strcat (rtos (/(getvar "perimeter")1000) 2 2) "lfm"))
(cons 8 (getvar "clayer"))
(cons 10 (list (car pk)(-(cadr pk)(getvar "textsize"))0.0))
(cons 40 (getvar "textsize"))
'(50 . 0.0)
) ;_ end of list
)
(setq laenge(+ laenge (/(getvar "perimeter")1000)))
(setq flaeche (+ flaeche (/(getvar "area")1000000)))
) ;_ end of repeat
(entmake
(list
'(0 . "TEXT")
(cons 1 (strcat "Gesamtfläche: " (rtos flaeche 2 2) "m²"))
(cons 8 (getvar "clayer"))
(cons 10 (setq txtpt(getpoint "\nEinfügungspunkt angeben: ")))
(cons 40 (getvar "textsize"))
'(50 . 0.0)
) ;_ end of list
) ;_ end of entmake
(entmake
(list
'(0 . "TEXT")
(cons 1 (strcat "Gesamtlänge: " (rtos laenge 2 2) "lfm"))
(cons 8 (getvar "clayer"))
(cons 10 (list (car txtpt)(-(cadr txtpt)(getvar "textsize"))0.0))
(cons 40 (getvar "textsize"))
'(50 . 0.0)
) ;_ end of list
)
) ;_ end of progn
) ;_ end of if
(setvar "clayer" clay)
(setvar "cmdecho" echo)
(princ
(strcat "\n* Gesamtfläche betraegt: " (rtos flaeche 2 2) "m²")
) ;_ end of princ
(princ)
) ;_ end of defun

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

Andreas Kraus
Mitglied
Elektrotechniker


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

Beiträge: 1380
Registriert: 11.01.2006

Win 10
ACAD 2022

erstellt am: 13. Apr. 2023 08:55    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 SNOOP_69 10 Unities + Antwort hilfreich

Fast gut, du musst nur den Schwerpunkt anders berechnen.

Code:
(defun C:FLAE-LAE-KALK-M (/ clay echo ss ant flaeche z laenge obj data pk)
  (vl-load-com)
  (setvar "textsize" 200)
  (setq clay (getvar "clayer")
echo (getvar "cmdecho")
  ) ;_ end of setq
; Eingabe
  (princ "\nPolylinien waehlen <Enter für alle Polylinien>: ")
  (setq ss (ssget '((-4 . "<or")
    (-4 . "<and")
    (0 . "LWPOLYLINE")
    (70 . 1)
    (-4 . "and>")
    (0 . "REGION,HATCH")
    (-4 . "or>")
  )
  ) ;_ end of ssget
  ) ;_ end of setq
  (if (not ss)
    (progn
      (initget "Alle Layer Objekt")
      (setq ant
    (getkword
      "\nAlle, auf aktuellen Layer oder auf Objekt layer: [Alle/Layer/Objekt]: "
    ) ;_ end of getkword
      ) ;_ end of setq
      (cond
((= ant "Alle")
(setq ss (ssget "_X"
'((-4 . "<or")
  (-4 . "<and")
  (0 . "LWPOLYLINE")
  (70 . 1)
  (-4 . "and>")
  (0 . "REGION,HATCH")
  (-4 . "or>")
  )
  ) ;_ end of ssget
) ;_ end of setq
)
((= ant "Layer")
(setq ss (ssget "X"
(list
  '((-4 . "<or")
    (-4 . "<and")
    (0 . "LWPOLYLINE")
    (70 . 1)
    (-4 . "and>")
    (0 . "REGION,HATCH")
    (-4 . "or>")
    )
  (cons 8 (getvar "clayer"))
) ;_ end of list
  ) ;_ end of ssget
) ;_ end of setq
)
((= ant "Objekt")
(setvar
  "clayer"
  (cdr (assoc 8 (entget (car (entsel "\nObjekt waehlen: ")))))
) ;_ end of setvar
(setq ss (ssget "X"
(list
  '((-4 . "<or")
    (-4 . "<and")
    (0 . "LWPOLYLINE")
    (70 . 1)
    (-4 . "and>")
    (0 . "REGION,HATCH")
    (-4 . "or>")
    )
  (cons 8 (getvar "clayer"))
) ;_ end of list
  ) ;_ end of ssget
) ;_ end of setq
)
      ) ;_ end of cond
    ) ;_ end of progn
  ) ;_ end of if
; Berechnung
  (if (not ss)
    (princ "\nKeine Polylinien gefunden!")
    (progn
      (setq flaeche 0
    laenge 0
    z -1
      ) ;_ end of setq
      (repeat (sslength ss)
(setq obj  (ssname ss (setq z (1+ z)))
      data (entget obj)
) ;_ end of setq
; Schwerpunkt berechnen
(vla-getboundingbox
  (vlax-ename->vla-object obj)
  'minp
  'maxp
)
(setq minp (vlax-safearray->list minp)
      maxp (vlax-safearray->list maxp)
      pk  (mapcar '/ (mapcar '+ minp maxp) '(2.0 2.0 2.0))
)
(command "_area" "Objekt" obj)
; Text setzen
(entmake
  (list
    '(0 . "TEXT")
    (cons 1
  (strcat (rtos (/ (getvar "area") 1000000) 2 2) "m²")
    )
    (cons 8 (getvar "clayer"))
    (cons 10 pk)
    (cons 40 (getvar "textsize"))
    '(50 . 0.0)
  ) ;_ end of list
) ;_ end of entmake
(entmake
  (list
    '(0 . "TEXT")
    (cons 1
  (strcat (rtos (/ (getvar "perimeter") 1000)
2
2
  )
  "lfm"
  )
    )
    (cons 8 (getvar "clayer"))
    (cons 10
  (list (car pk) (- (cadr pk) (getvar "textsize")) 0.0)
    )
    (cons 40 (getvar "textsize"))
    '(50 . 0.0)
  ) ;_ end of list
)
(setq laenge (+ laenge
(/ (getvar "perimeter") 1000)
    )
)
(setq flaeche (+ flaeche (/ (getvar "area") 1000000)))
      ) ;_ end of repeat
      (entmake
(list
  '(0 . "TEXT")
  (cons 1 (strcat "Gesamtfläche: " (rtos flaeche 2 2) "m²"))
  (cons 8 (getvar "clayer"))
  (cons 10
(setq txtpt (getpoint "\nEinfügungspunkt angeben: "))
  )
  (cons 40 (getvar "textsize"))
  '(50 . 0.0)
) ;_ end of listac
      ) ;_ end of entmake
      (entmake
(list
  '(0 . "TEXT")
  (cons 1 (strcat "Gesamtlänge: " (rtos laenge 2 2) "lfm"))
  (cons 8 (getvar "clayer"))
  (cons 10
(list (car txtpt) (- (cadr txtpt) (getvar "textsize")) 0.0)
  )
  (cons 40 (getvar "textsize"))
  '(50 . 0.0)
) ;_ end of list
      )
    ) ;_ end of progn
  ) ;_ end of if
  (setvar "clayer" clay)
  (setvar "cmdecho" echo)
  (princ
    (strcat "\n* Gesamtfläche betraegt: "
    (rtos flaeche 2 2)
    "m²"
    )
  ) ;_ end of princ
  (princ)
) ;_ end of defun

------------------
Geht nicht, gibts nicht

Gruß
Andreas

http://kraus-cad.de

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

archtools
Mitglied



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

Beiträge: 836
Registriert: 09.10.2004

Entwickler für AutoCAD, BricsCAD u.a., alle Systeme

erstellt am: 13. Apr. 2023 10: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 SNOOP_69 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von Andreas Kraus:
Fast gut, du musst nur den Schwerpunkt anders berechnen.

Code:
(defun C:FLAE-LAE-KALK-M (/ clay echo ss ant flaeche z laenge obj data pk)
  (vl-load-com)
  (setvar "textsize" 200)
) ;_ end of defun



Es ist SEHR sinnvoll, sich Lisp-Programme in keline, wiederverwendbare Progrämmchen aufzuteilen.

Der Schwerpunkt eines Polygons aus einer Punktliste (Vorsicht bei Polylinien o.ä. mit Bögen!) errechnet sich nach Gauß so:

Code:

(defun &SCHWERPUNKT-LPT ( lpt / idx area6 x y temp)
  (setq idx 0)
  (setq area6 (/ 1.0 (* 6.0 (&AREA-LPT lpt))))
  (if (not (equal (car lpt) (last lpt) 0.0001))
    (setq lpt (reverse (cons (car lpt) (reverse lpt))))
    )
  (setq x 0.0
y 0.0
)
  (repeat (1- (length lpt))
    (setq temp (* area6
  (+ (car (nth idx lpt)) (car (nth (1+ idx) lpt)))
  (- (* (car (nth idx lpt)) (cadr (nth (1+ idx) lpt)))
     (* (car (nth (1+ idx) lpt)) (cadr (nth idx lpt)))
  )
       )
    )
    (setq x (+ x temp))
    (setq idx (1+ idx))
  )
  (setq idx 0)
  (repeat (1- (length lpt))
    (setq temp (* area6
  (+ (cadr (nth idx lpt)) (cadr (nth (1+ idx) lpt)))
  (- (* (car (nth idx lpt)) (cadr (nth (1+ idx) lpt)))
     (* (car (nth (1+ idx) lpt)) (cadr (nth idx lpt)))
  )
       )
    )
    (setq y (+ y temp))
    (setq idx (1+ idx))
  )

  (list x y 0.0)
)


Die Fläche eines Polygons aus einer Punktliste nach der Gauß'schen Dreiecksformel so:

Code:

(defun &AREA-LPT (lpt / idx area temp)
  (setq idx  0
area 0.0
  )
  (if (not (equal (car lpt) (last lpt) 0.0001))
    (setq lpt (reverse (cons (car lpt) (reverse lpt))))
    )
  (repeat (1- (length lpt))
    (setq temp (* 0.5
  (- (* (car (nth idx lpt)) (cadr (nth (1+ idx) lpt)))
     (* (car (nth (1+ idx) lpt)) (cadr (nth idx lpt)))
  )
       )
    )
    (setq area (+ temp area))
    (setq idx (1+ idx))
  )
  area
)


Und hier noch eine Funktion, die für alle AutoCAD Objekte mit Fläche und Umfang beides ausgibt:


Code:

(defun &get-area-perimeter (en / obj start end area perimeter)
  (if (and (= 'ENAME (type en))
           (setq obj (vlax-ename->vla-object en))
      )
    (progn
      (if (vlax-property-available-p obj 'area)
        (vl-catch-all-error-p
          (setq
            area
            (vl-catch-all-apply 'vlax-curve-getArea (list obj))
          )
        )
      )
      (if (vlax-property-available-p obj 'perimeter)
        (vl-catch-all-error-p
          (setq perimeter (vlax-get-property obj 'perimeter))
        )
        ;;
        (if (and (setq start (vlax-curve-getStartParam obj))
                 (setq end (vlax-curve-getEndParam obj))
            )
          (progn
            (setq perimeter
                  (vlax-curve-getDistAtParam obj (- end start))
            )
          )
        )
      )
      (list area perimeter)
    )
  )
)


[Diese Nachricht wurde von archtools am 13. Apr. 2023 editiert.]

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

WNJT
Mitglied


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

Beiträge: 3
Registriert: 12.04.2023

AutoCad 2020

erstellt am: 13. Apr. 2023 19: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 Nur für SNOOP_69 10 Unities + Antwort hilfreich

Wow Großartig! Das funktioniert perfekt! Vielen Lieben Dank, damit habt ihr mir wirklich weitergeholfen!

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