| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
| |
| AERZEN konsolidiert weltweite Autodesk Softwarelizenzen mit CIDEON (Autodesk, AutoCAD, Inventor), ein Anwenderbericht
|
Autor
|
Thema: LISP ändern (1577 / mal gelesen)
|
SNOOP_69 Mitglied Konstrukteur - Innenausbau
Beiträge: 553 Registriert: 25.01.2006 Hardware: - Lenovo-W540 Software: - Win10 Pro 64bit - Autocad 2022-2024 (Vollversion+LT) - BricsCad - DraftSight 2023 - SolidWorks 2019-2023 - SWOOD 2023 - MasterCAM 2020-2023
|
erstellt am: 24. Jul. 2019 08:11 <-- editieren / zitieren --> Unities abgeben:
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 良い精神
Beiträge: 22275 Registriert: 03.06.2002 System: F1 und Google
|
erstellt am: 24. Jul. 2019 08:21 <-- editieren / zitieren --> Unities abgeben: Nur für SNOOP_69
|
cadffm Moderator 良い精神
Beiträge: 22275 Registriert: 03.06.2002 System: F1 und Google
|
erstellt am: 24. Jul. 2019 08:31 <-- editieren / zitieren --> Unities abgeben: Nur für SNOOP_69
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
Beiträge: 553 Registriert: 25.01.2006 Hardware: - Lenovo-W540 Software: - Win10 Pro 64bit - Autocad 2022-2024 (Vollversion+LT) - BricsCad - DraftSight 2023 - SolidWorks 2019-2023 - SWOOD 2023 - MasterCAM 2020-2023
|
erstellt am: 24. Jul. 2019 09:15 <-- editieren / zitieren --> Unities abgeben:
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
Beiträge: 14 Registriert: 12.04.2023 AutoCad 2020
|
erstellt am: 12. Apr. 2023 12:45 <-- editieren / zitieren --> Unities abgeben: Nur für SNOOP_69
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
Beiträge: 1455 Registriert: 11.01.2006 WIN 10 ACAD 2022 BricsCAD V23
|
erstellt am: 12. Apr. 2023 15:47 <-- editieren / zitieren --> Unities abgeben: Nur für SNOOP_69
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
Beiträge: 14 Registriert: 12.04.2023 AutoCad 2020
|
erstellt am: 12. Apr. 2023 16:41 <-- editieren / zitieren --> Unities abgeben: Nur für SNOOP_69
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
Beiträge: 1455 Registriert: 11.01.2006 WIN 10 ACAD 2022 BricsCAD V23
|
erstellt am: 13. Apr. 2023 08:55 <-- editieren / zitieren --> Unities abgeben: Nur für SNOOP_69
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
Beiträge: 965 Registriert: 09.10.2004 Entwickler für AutoCAD, BricsCAD u.a., alle Systeme
|
erstellt am: 13. Apr. 2023 10:22 <-- editieren / zitieren --> Unities abgeben: Nur für SNOOP_69
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
Beiträge: 14 Registriert: 12.04.2023 AutoCad 2020
|
erstellt am: 13. Apr. 2023 19:04 <-- editieren / zitieren --> Unities abgeben: Nur für SNOOP_69
|