neue Folder LAYOUT MENU und MODULE dazu

2025-04-14 16:56:58 +02:00
parent e6e1705f0d
commit 35f7b2d75e
935 changed files with 803964 additions and 0 deletions
@@ -0,0 +1,64 @@
+(defun c:mbl ( / index)
+  (prompt "**** Block mit Properties bilden *******")
+  (prompt "")
+  (setq auswahl-satz nil)
+  (setq auswahl-satz (ssget))
+  (setq PT0 (getpoint "\nUrsprung antippen: "))
+  (bl-name PT0) ; block-kennung ermitteln (in SSTBASE)
+  (setq index 0.0)
+  (while (< index (sslength auswahl-satz))          ; Anfang WHILE
+    (setq E (ssname auswahl-satz index))            ; Entity-Name setzen
+    (setq blockname (cdr (assoc 2 (entget e))))     ; BLOCKNAME ermitteln
+    (print blockname)                               ; Blockname drucken
+    (print E)                                       ; und auf SCRREN anzeigen
+    (setq TYP (cdr (assoc 0 (entget E))))           ; Objekt-ART 
+    (if
+      (and
+        (equal typ "INSERT")                        ; wenn BLOCK
+        (equal (cdr (assoc 66 (entget e))) 1)       ; und ATTRIBUTE vorhanden
+      )
+      (progn                                        ; dann
+        (einzel-attr-aendern "C" block-kennung 0)   ; oberen Block „ndern
+        (setq OBJ1   (tblsearch "BLOCK" blockname)) ; in der Blocktabelle suchen
+        (setq OBJEKT (cdr (assoc -2 OBJ1)))         ; n„chstes Objekt
+        (princ OBJ1)
+        (while OBJEKT                               ; f�r alle Objekte des Blockes
+;          (einzel-attr-aendern "C" block-kennung 0)  
+;          (setq typ1 (cdr (assoc 0 (entget OBJEKT))))
+          (setq typ2 (cdr (assoc 2 (entget OBJEKT))))
+          (if (equal typ2 "C")
+            (entmod (subst (cons 1 block-kennung) (assoc 1 (entget OBJEKT)) (entget OBJEKT)))
+          )  
+          (setq OBJEKT (entnext OBJEKT))           ; n„chstes Objekt
+        )                                          ; ende WHILE f�r alle Objekte des Blockes
+      )
+    )
+    (setq index (1+ index))
+  )                                                 ; ende WHILE
+  (princ)
+  (mach-block PT0 "0" auswahl-satz)
+  (attribute-aendern "0" "2" "1" "" "" block-kennung "" "" "" "")  ; in SSTBASE.LSP
+  (setq auswahl-satz nil)
+)
+
+
+
+
+
+
+;(defun c:blockliste (/ datei block objekt)
+;  (setq datei (open (strcat (getvar "DWGNAME") ".BLK") "w"))
+;  (setq block (tblnext "BLOCK" t))
+;  (while block
+;    (print block datei)
+;    (setq objekt (cdr (assoc -2 block)))
+;    (while objekt
+;      (print (entget objekt) datei)
+;      (setq objekt (entnext objekt))
+;    )
+;    (setq block (tblnext "BLOCK"))
+;  )
+;  (close datei)
+;  (princ)
+;)
+