AutoCAD, Bricscad Wir machen das Mögliche unmöglich
erstellt am: 07. Jul. 2017 10:21 <-- editieren / zitieren --> Unities abgeben: Nur für SNOOP_69
Code:(defun C:fla_ber ( / clay echo ss ant fläche z laength obj data plist pk ) (vl-load-com) (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) "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)) 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)))) (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) "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
------------------ Gruß CADwiesel Besucht uns im CHAT