将图块及其内部所有实体改为0层

小毛草 · 发表于 2025-12-26 11:33:33

;;; 将图块及其内部所有实体改为0层
(defun c:sbb (/ selectionSet count blockEntity blockName blockDef blockEntities entity)
(if (setq selectionSet (ssget '((0 . "INSERT"))))
(progn
(setq count 0)
(repeat (sslength selectionSet)
(setq blockEntity (ssname selectionSet count))
(setq blockName (cdr (assoc 2 (entget blockEntity))))
(setq blockDef (tblobjname "block" blockName))
;; 获取并处理图块定义中的实体
(if blockDef
(progn
(setq blockEntities (ayGetAllEntInBLK blockName))
;; 修改图块内部所有实体的图层和颜色
(foreach entity blockEntities
(changeEntityLayerAndColor entity)
)
)
)
;; 修改图块插入点本身的图层
(changeEntityLayerAndColor blockEntity)
(setq count (1+ count))
)
(command "regen")
(princ (strcat "\n已处理 " (itoa count) " 个图块"))
)
(princ "\n未选择到图块")
)
(princ)
)
;;; 修改实体的图层和颜色
(defun changeEntityLayerAndColor (entityName / entityData)
(if (entget entityName)
(progn
(setq entityData (entget entityName))
;; 修改图层为"0"
(setq entityData (subst (cons 8 "0") (assoc 8 entityData) entityData))
;; 如果存在颜色，改为随层(256表示ByLayer)
(if (assoc 62 entityData)
(setq entityData (subst (cons 62 256) (assoc 62 entityData) entityData))
)
(entmod entityData)
(entupd entityName) ;; 更新显示
)
)
)
;;;***********************************************************
;;; 获取图块内的所有非图块对象(含嵌套块中的)实体名称
;;;***********************************************************
(defun ayGetAllEntInBLK (blkName / blkDef entityList entity entityType nestedName nestedDef)
(setq blkDef (tblobjname "block" blkName))
(setq entityList nil)
(if blkDef
(progn
(setq entity (entnext blkDef))
(while entity
(setq entityType (cdr (assoc 0 (entget entity))))
(cond
((= entityType "INSERT")
;; 处理嵌套块
(setq nestedName (cdr (assoc 2 (entget entity))))
(if (not (member nestedName '("*MODEL_SPACE" "*PAPER_SPACE" "*PAPER_SPACE0")))
(progn
;; 将嵌套块本身加入列表
(setq entityList (cons entity entityList))
;; 递归获取嵌套块内部实体
(setq entityList (append (ayGetAllEntInBLK nestedName) entityList))
)
)
)
((/= entityType "ENDBLK")
;; 添加非块结束标记的实体
(setq entityList (cons entity entityList))
)
)
(setq entity (entnext entity))
)
)
)
entityList
)

;;; 将图块及其内部所有实体改为0层 
(defun c:sbb (/ selectionSet count blockEntity blockName blockDef blockEntities entity) 
  (if (setq selectionSet (ssget '((0 . "INSERT")))) 
    (progn 
      (setq count 0) 
      (repeat (sslength selectionSet) 
        (setq blockEntity (ssname selectionSet count)) 
        (setq blockName (cdr (assoc 2 (entget blockEntity)))) 
        (setq blockDef (tblobjname "block" blockName)) 
         
        ;; 获取并处理图块定义中的实体 
        (if blockDef 
          (progn 
            (setq blockEntities (ayGetAllEntInBLK blockName)) 
             
            ;; 修改图块内部所有实体的图层和颜色 
            (foreach entity blockEntities 
              (changeEntityLayerAndColor entity) 
            ) 
          ) 
        ) 
         
        ;; 修改图块插入点本身的图层 
        (changeEntityLayerAndColor blockEntity) 
         
        (setq count (1+ count)) 
      ) 
      (command "regen") 
      (princ (strcat "\n已处理 " (itoa count) " 个图块")) 
    ) 
    (princ "\n未选择到图块") 
  ) 
  (princ) 
) 
 
;;; 修改实体的图层和颜色 
(defun changeEntityLayerAndColor (entityName / entityData) 
  (if (entget entityName) 
    (progn 
      (setq entityData (entget entityName)) 
       
      ;; 修改图层为"0" 
      (setq entityData (subst (cons 8 "0") (assoc 8 entityData) entityData)) 
       
      ;; 如果存在颜色，改为随层(256表示ByLayer) 
      (if (assoc 62 entityData) 
        (setq entityData (subst (cons 62 256) (assoc 62 entityData) entityData)) 
      ) 
       
      (entmod entityData) 
      (entupd entityName)  ;; 更新显示 
    ) 
  ) 
) 
 
;;;*********************************************************** 
;;; 获取图块内的所有非图块对象(含嵌套块中的)实体名称 
;;;*********************************************************** 
(defun ayGetAllEntInBLK (blkName / blkDef entityList entity entityType nestedName nestedDef) 
  (setq blkDef (tblobjname "block" blkName)) 
  (setq entityList nil) 
   
  (if blkDef 
    (progn 
      (setq entity (entnext blkDef)) 
       
      (while entity 
        (setq entityType (cdr (assoc 0 (entget entity)))) 
         
        (cond 
          ((= entityType "INSERT") 
           ;; 处理嵌套块 
           (setq nestedName (cdr (assoc 2 (entget entity)))) 
           (if (not (member nestedName '("*MODEL_SPACE" "*PAPER_SPACE" "*PAPER_SPACE0"))) 
             (progn 
               ;; 将嵌套块本身加入列表 
               (setq entityList (cons entity entityList)) 
               ;; 递归获取嵌套块内部实体 
               (setq entityList (append (ayGetAllEntInBLK nestedName) entityList)) 
             ) 
           ) 
          ) 
          
          ((/= entityType "ENDBLK") 
           ;; 添加非块结束标记的实体 
           (setq entityList (cons entity entityList)) 
          ) 
        ) 
         
        (setq entity (entnext entity)) 
      ) 
    ) 
  ) 
   
  entityList 
)

小毛草 · 发表于 2025-12-31 10:16:14

本帖最后由小毛草于 2025-12-31 10:20 编辑

增加可以保留线型和颜色选择，让你们自已选择用那一个了！

;;; 全局变量，用于记忆是否保留线型和颜色
(setq *SBB-RETAIN-PROPERTIES* nil)
;;; 将图块及其内部所有实体改为0层
(defun c:sbb (/ selectionSet count blockEntity blockEntities entity key gr olderr)
;; 定义错误处理函数
(defun *error* (msg)
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ (strcat "\n错误: " msg))
)
; 恢复原来的错误处理函数
(setq *error* olderr)
(princ)
)
; 保存原来的错误处理函数
(setq olderr *error*)
;; 显示当前设置
(princ (strcat "\n当前设置: "
(if *SBB-RETAIN-PROPERTIES*
"保留原线型和颜色"
"修改为0层并随层")
" (按S键切换, 按ESC或右键退出)"))
; 循环处理
(setq key nil)
(while (and (not key) (setq gr (grread T 15 0)))
(cond
((= (car gr) 2) ; 键盘输入
(cond
((or (= (cadr gr) 13) (= (cadr gr) 32)) ; 回车或空格键
(setq key T) ; 退出循环
)
((or (= (cadr gr) 83) (= (cadr gr) 115)) ; S或s键 - 切换方式
(setq *SBB-RETAIN-PROPERTIES* (not *SBB-RETAIN-PROPERTIES*))
(princ (strcat "\r当前设置: "
(if *SBB-RETAIN-PROPERTIES*
"保留原线型和颜色"
"修改为0层并随层")
" (左键确认选择进行选择图块，按S键切换, 按ESC或右键退出)"))
)
((= (cadr gr) 27) ; ESC键退出
(setq key T)
(princ "\n命令结束")
)
(T
; 其他按键，继续等待
)
)
)
((= (car gr) 3) ; 鼠标左键点击
;; 开始选择图块
(princ "\n选择图块: ")
(if (setq selectionSet (ssget '((0 . "INSERT"))))
(progn
(setq count 0)
(repeat (sslength selectionSet)
(setq blockEntity (ssname selectionSet count))
(setq blockEntities (ayGetAllEntInBLK blockEntity))
;; 修改图块内部所有实体的图层
(foreach entity blockEntities
(changeEntityProperties entity *SBB-RETAIN-PROPERTIES*)
)
;; 修改图块本身的图层
(changeEntityProperties blockEntity *SBB-RETAIN-PROPERTIES*)
(setq count (1+ count))
)
(command "regen")
(princ (strcat "\n已处理 " (itoa count) " 个图块"))
;; 显示当前设置，等待下一次操作
(princ (strcat "\n当前设置: "
(if *SBB-RETAIN-PROPERTIES*
"保留原线型和颜色"
"修改为0层并随层")
" (左键确认选择进行选择图块，按S键切换, 按ESC或右键退出)"))
)
(princ "\n未选择到图块")
)
)
((= (car gr) 11) ; 鼠标右键
(setq key T) ; 退出循环
(princ "\n命令结束")
)
((= (car gr) 25) ; 取消操作
(setq key T)
(princ "\n命令结束")
)
(T
; 其他输入，继续等待
)
)
)
;; 恢复原来的错误处理函数
(setq *error* olderr)
(princ)
)
;;; 修改实体的属性
(defun changeEntityProperties (entityName retainProperties / entityData)
(setq entityData (entget entityName))
;; 修改图层为"0"
(setq entityData (subst (cons 8 "0") (assoc 8 entityData) entityData))
;; 如果不保留属性，则修改颜色和线型为随层
(if (not retainProperties)
(progn
;; 修改颜色为随层(0)
(if (assoc 62 entityData)
(setq entityData (subst (cons 62 0) (assoc 62 entityData) entityData))
(setq entityData (append entityData (list (cons 62 0))))
)
;; 修改线型为随层
(if (assoc 6 entityData)
(setq entityData (subst (cons 6 "ByLayer") (assoc 6 entityData) entityData))
(setq entityData (append entityData (list (cons 6 "ByLayer"))))
)
;; 修改线型比例为1
(if (assoc 48 entityData)
(setq entityData (subst (cons 48 1.0) (assoc 48 entityData) entityData))
)
)
)
(entmod entityData)
)
;;;***********************************************************
;;; 获取图块内的所有非图块对象(含嵌套块中的)名称函数
;;;***********************************************************
(defun ayGetAllEntInBLK (blkEntName / blockName blockDef nextEntity entityType entityList)
(setq blockName (cdr (assoc 2 (entget blkEntName))))
(setq blockDef (tblobjname "Block" blockName))
(while (setq nextEntity (entnext blockDef))
(setq entityType (cdr (assoc 0 (entget nextEntity))))
(if (= entityType "INSERT")
(progn
(setq entityList (cons nextEntity entityList))
(setq entityList (append (ayGetAllEntInBLK nextEntity) entityList))
)
(setq entityList (cons nextEntity entityList))
)
(setq blockDef nextEntity)
)
entityList
)

;;; 全局变量，用于记忆是否保留线型和颜色 
(setq *SBB-RETAIN-PROPERTIES* nil) 
 
;;; 将图块及其内部所有实体改为0层 
(defun c:sbb (/ selectionSet count blockEntity blockEntities entity key gr olderr) 
  ;; 定义错误处理函数 
  (defun *error* (msg) 
    (if (not (member msg '("Function cancelled" "quit / exit abort"))) 
      (princ (strcat "\n错误: " msg)) 
    ) 
    ; 恢复原来的错误处理函数 
    (setq *error* olderr) 
    (princ) 
  ) 
   
  ; 保存原来的错误处理函数 
  (setq olderr *error*) 
   
  ;; 显示当前设置 
  (princ (strcat "\n当前设置: " 
                 (if *SBB-RETAIN-PROPERTIES* 
                     "保留原线型和颜色" 
                     "修改为0层并随层") 
                 " (按S键切换, 按ESC或右键退出)")) 
   
  ; 循环处理 
  (setq key nil) 
  (while (and (not key) (setq gr (grread T 15 0))) 
    (cond 
      ((= (car gr) 2) ; 键盘输入 
       (cond 
         ((or (= (cadr gr) 13) (= (cadr gr) 32)) ; 回车或空格键 
          (setq key T) ; 退出循环 
         ) 
         ((or (= (cadr gr) 83) (= (cadr gr) 115)) ; S或s键 - 切换方式 
          (setq *SBB-RETAIN-PROPERTIES* (not *SBB-RETAIN-PROPERTIES*)) 
          (princ (strcat "\r当前设置: " 
                         (if *SBB-RETAIN-PROPERTIES* 
                             "保留原线型和颜色" 
                             "修改为0层并随层") 
                         " (左键确认选择进行选择图块，按S键切换, 按ESC或右键退出)")) 
         ) 
         ((= (cadr gr) 27) ; ESC键退出 
          (setq key T) 
          (princ "\n命令结束") 
         ) 
         (T 
          ; 其他按键，继续等待 
         ) 
       ) 
      ) 
      ((= (car gr) 3) ; 鼠标左键点击 
       ;; 开始选择图块 
       (princ "\n选择图块: ") 
       
       (if (setq selectionSet (ssget '((0 . "INSERT")))) 
         (progn 
           (setq count 0) 
           (repeat (sslength selectionSet) 
             (setq blockEntity (ssname selectionSet count)) 
             (setq blockEntities (ayGetAllEntInBLK blockEntity)) 
             
             ;; 修改图块内部所有实体的图层 
             (foreach entity blockEntities 
               (changeEntityProperties entity *SBB-RETAIN-PROPERTIES*) 
             ) 
             
             ;; 修改图块本身的图层 
             (changeEntityProperties blockEntity *SBB-RETAIN-PROPERTIES*) 
             
             (setq count (1+ count)) 
           ) 
           (command "regen") 
           (princ (strcat "\n已处理 " (itoa count) " 个图块")) 
            
           ;; 显示当前设置，等待下一次操作 
           (princ (strcat "\n当前设置: " 
                          (if *SBB-RETAIN-PROPERTIES* 
                              "保留原线型和颜色" 
                              "修改为0层并随层") 
                          " (左键确认选择进行选择图块，按S键切换, 按ESC或右键退出)")) 
         ) 
         (princ "\n未选择到图块") 
       ) 
      ) 
      ((= (car gr) 11) ; 鼠标右键 
       (setq key T) ; 退出循环 
       (princ "\n命令结束") 
      ) 
      ((= (car gr) 25) ; 取消操作 
       (setq key T) 
       (princ "\n命令结束") 
      ) 
      (T 
       ; 其他输入，继续等待 
      ) 
    ) 
  ) 
   
  ;; 恢复原来的错误处理函数 
  (setq *error* olderr) 
   
  (princ) 
) 
 
;;; 修改实体的属性 
(defun changeEntityProperties (entityName retainProperties / entityData) 
  (setq entityData (entget entityName)) 
   
  ;; 修改图层为"0" 
  (setq entityData (subst (cons 8 "0") (assoc 8 entityData) entityData)) 
   
  ;; 如果不保留属性，则修改颜色和线型为随层 
  (if (not retainProperties) 
    (progn 
      ;; 修改颜色为随层(0) 
      (if (assoc 62 entityData) 
        (setq entityData (subst (cons 62 0) (assoc 62 entityData) entityData)) 
        (setq entityData (append entityData (list (cons 62 0)))) 
      ) 
       
      ;; 修改线型为随层 
      (if (assoc 6 entityData) 
        (setq entityData (subst (cons 6 "ByLayer") (assoc 6 entityData) entityData)) 
        (setq entityData (append entityData (list (cons 6 "ByLayer")))) 
      ) 
       
      ;; 修改线型比例为1 
      (if (assoc 48 entityData) 
        (setq entityData (subst (cons 48 1.0) (assoc 48 entityData) entityData)) 
      ) 
    ) 
  ) 
   
  (entmod entityData) 
) 
 
;;;*********************************************************** 
;;; 获取图块内的所有非图块对象(含嵌套块中的)名称 函数 
;;;*********************************************************** 
(defun ayGetAllEntInBLK (blkEntName / blockName blockDef nextEntity entityType entityList) 
  (setq blockName (cdr (assoc 2 (entget blkEntName)))) 
  (setq blockDef (tblobjname "Block" blockName)) 
   
  (while (setq nextEntity (entnext blockDef)) 
    (setq entityType (cdr (assoc 0 (entget nextEntity)))) 
    
    (if (= entityType "INSERT") 
      (progn 
        (setq entityList (cons nextEntity entityList)) 
        (setq entityList (append (ayGetAllEntInBLK nextEntity) entityList)) 
      ) 
      (setq entityList (cons nextEntity entityList)) 
    ) 
    
    (setq blockDef nextEntity) 
  ) 
   
  entityList 
)

wudechao · 发表于 2025-12-26 12:51:52

本帖最后由 wudechao 于 2025-12-26 13:02 编辑

单一功能的图元，改为图块内为0层还算可以，布局里面视口控制哪个图层显示很好用，假如图块是多种不同功能图元，改为0层，副作用很大，很难管理。比如在建筑提资给其它专业的图，建筑大佬做很多任意的图块，图块中的东西很任意，比如柱子图层，剪力墙图层，墙图层，窗户图层等等都放在一个图块里。这种乱七八糟的图块，很伤脑筋。炸开也不是，不炸做0图层图块也不是。比如一个超大地下室平面，每个塔楼就是一个图块，这种按塔楼的图块里面是不能改为0图层的了，但是这图块外面所在的图层改为什么图层才好用？这个种乱七八糟的图块，图层如何管理是个难点。单一功能的图层的图块，比如集水井，窗户，门，这种图块改为0图层，非常好，在布局很好控制显示和关闭。

tranque · 发表于 2025-12-26 13:19:16

wudechao 发表于 2025-12-26 12:51
单一功能的图元，改为图块内为0层还算可以，布局里面视口控制哪个图层显示很好用，假如图块是多种不同功能 ...

CAD还有其他专业呢，这个功能室内专业经常用，对室内二次开发的插件都有这个功能: 海龙、快图、源泉、imini

不一样地设计 · 发表于 2025-12-26 12:17:47

感谢分享！！！

chenlianghuai · 发表于 2025-12-26 12:59:58

学习学习学习

nzdog · 发表于 2025-12-27 14:29:53

谢谢分享，运行测试反应时间有点久

海盗曹 · 发表于 2025-12-30 17:36:48

点赞，下载，收藏！

Nico · 发表于 2025-12-30 19:03:48

刚好能用到

konoko · 发表于 2025-12-30 21:11:19

感谢分享！很有用，要是能只改0层，保留图里的线型和颜色就更好了。

账号		自动登录	找回密码
密码			注册

[源码] 将图块及其内部所有实体改为0层

评分