Blöcke auflösen, aber den Attributtext behalten

Reiner Text, nichts ist versteckt. Kopieren Sie ihn in eine Datei namens cxblkxp.lsp oder laden Sie ihn herunter.

;;; ============================================================================
;;; CXBLKXP - Explode blocks and keep the attribute texts
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxblkxp
;;; Tested in: AutoCAD (full version). Other programs that run AutoLISP may work but are not tested.
;;; Copyright (c) CADXChange. Free for personal and commercial use; do not resell or
;;; republish it as a collection. Terms: https://cadxchange.net/legal/lisp-terms
;;; ============================================================================

;; A single-line TEXT with the look and place of the attribute ATT.
(defun cx:blkxp-text (att / ed)
  (setq ed (entget att))
  (entmakex
    (append
      (list '(0 . "TEXT") (cons 8 (cx:dxf 8 ed)))
      (if (cx:dxf 62 ed) (list (cons 62 (cx:dxf 62 ed))))
      (list (cons 10 (cx:dxf 10 ed)) (cons 40 (cx:dxf 40 ed)) (cons 1 (cx:dxf 1 ed))
            (cons 50 (if (cx:dxf 50 ed) (cx:dxf 50 ed) 0.0))
            (cons 41 (if (cx:dxf 41 ed) (cx:dxf 41 ed) 1.0))
            (cons 51 (if (cx:dxf 51 ed) (cx:dxf 51 ed) 0.0))
            (cons 7 (if (cx:dxf 7 ed) (cx:dxf 7 ed) "STANDARD"))
            (cons 72 (if (cx:dxf 72 ed) (cx:dxf 72 ed) 0)))
      (if (and (cx:dxf 11 ed) (or (/= 0 (cx:dxf 72 ed)) (/= 0 (cx:dxf 74 ed)))) (list (cons 11 (cx:dxf 11 ed))))
      (list '(100 . "AcDbText") (cons 73 (if (cx:dxf 74 ed) (cx:dxf 74 ed) 0))))))

;; Explode the block reference INS and keep its attribute values as plain texts (the tags are not left behind).
;; SHOWHIDDEN = T also turns hidden attributes into texts. Returns how many texts were made.
(defun cx:blkxp-run (ins showhidden / atts texts mark e dels)
  (foreach a (cx:attribs ins)
    (if (or showhidden (= 0 (logand 1 (cx:dxf 70 (entget a)))))
      (setq atts (cons a atts))))
  (setq atts (reverse atts))
  ;; The texts must be made before the explode erases the attributes
  (setq texts (mapcar 'cx:blkxp-text atts))
  (setq mark (entmakex '((0 . "POINT") (10 0.0 0.0 0.0))))
  (command "_.EXPLODE" ins)
  (setq e (entnext mark))
  ;; Nothing was created: the block could not be exploded, so no texts are kept either
  (if (null e) (progn (foreach tx texts (entdel tx)) (setq texts nil)))
  (while e
    (if (= (cx:dxf 0 (entget e)) "ATTDEF") (setq dels (cons e dels)))
    (setq e (entnext e)))
  (foreach d dels (entdel d))
  (entdel mark)
  (length texts))

(defun c:CXBLKXP ( / *error* cx:sv ss hidden n)
  (setq *error* cx:err)
  (if (setq ss (cx:pick "\nSelect blocks with attributes: " '((0 . "INSERT") (66 . 1))))
    (progn
      (setq hidden (= (cx:ask-kw "Also turn hidden attributes into texts" "Yes No" "No") "Yes"))
      (cx:start '(("CMDECHO" . 0)))
      (setq n 0)
      (foreach e (cx:ss->list ss) (setq n (+ n (cx:blkxp-run e hidden))))
      (princ (strcat "\n" (itoa (sslength ss)) " block(s) exploded, " (itoa n) " attribute text(s) kept."))
      (cx:end)))
  (princ))


;;; ---- Shared helpers (used by the command above; identical in every CADXChange tool) ----

(defun cx:dxf (code ed)
  (cdr (assoc code ed)))

;; The ATTRIB entities of a block reference, in order.
(defun cx:attribs (ins / e out)
  (setq e (entnext ins))
  (while (and e (= (cx:dxf 0 (entget e)) "ATTRIB"))
    (setq out (cons e out) e (entnext e)))
  (reverse out))

;; Close the undo step and put the system variables back.
(defun cx:end ()
  (foreach v cx:sv (setvar (car v) (cdr v)))
  (command "_.UNDO" "_End")
  (setq cx:sv nil)
  (princ))

;; Error handler: restores everything, stays quiet on Esc.
(defun cx:err (msg)
  (if (> (getvar "CMDACTIVE") 0) (command))
  (cx:end)
  (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg)))
  (princ))

;; Use the objects already selected, or ask the user to select; FILTER is an ssget filter list or nil.
(defun cx:pick (msg filter / ss)
  (setq ss (if filter (ssget "_I" filter) (ssget "_I")))
  (if (null ss)
    (progn
      (princ msg)
      (setq ss (if filter (ssget filter) (ssget)))))
  ss)

;; Replace every OLD in STR by NEW (case sensitive).
(defun cx:replace (str old new / n out pos)
  (setq n (strlen old) out "" pos 1)
  (if (= n 0)
    str
    (progn
      (while (<= pos (1+ (- (strlen str) n)))
        (if (= (substr str pos n) old)
          (setq out (strcat out new) pos (+ pos n))
          (setq out (strcat out (substr str pos 1)) pos (1+ pos))))
      (strcat out (substr str pos)))))

;; Ask for one of the keywords in BITS ("Yes No"), default DEF; returns the keyword.
(defun cx:ask-kw (msg bits def / v)
  (initget 0 bits)
  (setq v (getkword (strcat "\n" msg " [" (cx:replace bits " " "/") "] <" def ">: ")))
  (if v v def))

;; Save the system variables in VARS ((name . value) ...), set them, and open one undo step.
;; The caller declares cx:sv as a local so the saved values live exactly as long as the command.
(defun cx:start (vars)
  (setq cx:sv (mapcar (function (lambda (v) (cons (car v) (getvar (car v))))) vars))
  (command "_.UNDO" "_Begin")
  (foreach v vars (setvar (car v) (cdr v)))
  (princ))

;; Selection set to a list of entity names.
(defun cx:ss->list (ss / i out)
  (setq i 0)
  (if ss
    (repeat (sslength ss)
      (setq out (cons (ssname ss i) out)
            i   (1+ i))))
  (reverse out))

(princ "\nCXBLKXP loaded. Type CXBLKXP to start.")
(princ)

Weitere Befehle: Blöcke und Attribute

• CXATTFILLEin Attribut in vielen Blöcken ausfüllen
• CXATTNUMEin Blockattribut fortlaufend nummerieren
• CXATTCOPYAttributwerte von einem Block auf andere kopieren
• CXATTVISBlockattribute ein- oder ausblenden
• CXBLKCOUNTBlöcke nach Namen zählen
• CXBLKREPLBlöcke durch einen anderen Block ersetzen
• CXBLKRENBlöcke gesammelt umbenennen
• CXBLKSELBlöcke nach Name oder Attributwert auswählen
• CXBLKATEinen Block an vielen Stellen auf einmal einfügen