不打印块检测

thriving · 发表于前天 17:31

本帖最后由 thriving 于 2025-9-2 08:20 编辑

以前做的一个功能，输出可能不太完善，大致可以满足如题功能，现源码上传；
输出对象是非打印的块，块内须有打印的图层

(setq
;;常用VLA对象、集合
*ACAD* (vlax-get-acad-object)
*DOC* (vla-get-ActiveDocument *ACAD*)
*DOCS* (vla-get-Documents *ACAD*)
*MS* (vla-get-modelSpace *DOC*)
*PS* (vla-get-paperSpace *DOC*)
*BLKS* (vla-get-Blocks *DOC*)
*LAYS* (vla-get-Layers *DOC*)
*LTS* (vla-get-Linetypes *DOC*)
*STS* (vla-get-TextStyles *DOC*)
*GRPS* (vla-get-groups *DOC*)
*DIMS* (vla-get-DimStyles *DOC*)
*LOUTS* (vla-get-Layouts *DOC*)
*VPS* (vla-get-Viewports *DOC*)
*VS* (vla-get-Views *DOC*)
*DICS* (vla-get-Dictionaries *DOC*)
*Layouts* (vla-get-Layouts *doc*)
)
;;返回所有图层对应的对象名(大写)
;;返回：((图层名1 对象名1) (图层名2 对象名2)……)
(defun try-Layer-obj-name (/ ob)
(vlax-for each (vla-get-Layers *DOC*)
(setq ob(cons(list (vla-get-name each)each) ob))
)
ob
)
;;返回所有图层的名称(字符串表)
(defun try-Layer-allname(/ out)
(vlax-for obj *LAYS*
(setq out (cons (vlax-get-property obj 'Name) out))
)
(reverse out)
)
;|
返回所有图层的信息
(("层名" 状态颜色 "线型")……)
状态：1冻结图层 2新视口冻结图层 4锁定…(其他看帮助)
颜色：负值为隐藏图层
|;
(defun try-Layer-Info (/ lst d e1 e2)
(while (setq d (tblnext "layer" (null d)))
(setq lst (cons (mapcar 'cdr (cdr d)) lst) )
)
(vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2))))
)
;;获取指定图层的图元名
;;(try-Layer-ent "0") --> <图元名: -64cb388>
(defun try-Layer-ent (name)(tblobjname "layer" name))
;;打开关闭图层
;;参数：图层名称表
(defun try-Layer-On (LayList)
(setq LayList(mapcar 'strcase LayList))
(vlax-for each *LAYS*
(if (member (strcase (vla-get-name each)) LayList)
(if (vlax-write-enabled-p each)
(vla-put-LayerOn each :vlax-True)
)
)
(vlax-release-object each)
)
)
;;关闭图层
;;参数：图层名称表
(defun try-Layer-Off (LayList)
(setq LayList(mapcar 'strcase LayList))
(vlax-for each *LAYS*
(if (member (strcase (vla-get-name each)) LayList)
(if (vlax-write-enabled-p each)
(vla-put-LayerOn each :vlax-False)
)
)
(vlax-release-object each)
)
)
;;设置指定图层(列表)不打印
;;参数1、图层列表
;;参数2、是否打印（T打印/nil不打印）
(defun try-Layer-Plot (LayList On-Off)
(vlax-for each (vla-get-Layers *DOC*)
(if (member (strcase (vla-get-name each)) (mapcar 'strcase LayList))
(if (vlax-write-enabled-p each)
(if On-Off
(vla-put-Plottable each :vlax-True)
(vla-put-Plottable each :vlax-False)
)
)
)
(vlax-release-object each)
)
)
;;;创建一个图层
;;;参数1:name:图层名称
;;;参数2:colour:颜色默认nil(7)
;;;参数3:xianxin:线型默认nil(Continuous)
;;;参数4:n70:标志位，默认nil(0)（详见函数内注释）
;;;示例: (try-make-layer "abc" nil nil nil)
(defun try-layer-make (name colour xianxin n70)
(or n70 (setq n70 0))
;标准标记（按位编码值）：
;1 = 冻结图层，否则解冻图层
;2 = 默认情况下在新视口中冻结图层
;4 = 锁定图层
;16 = 如果设置了此位，则表条目外部依赖于外部参照
;32 = 如果同时设置了此位和位 16，则表明已成功融入了外部依赖的外部参照
;64 = 如果设置了此位，则表明在上次编辑图形时，图形中至少有一个图元参照了表条目。（此标志适用于 AutoCAD 命令。大多数读取 DXF 文件的程序都可以忽略它，并且无需由写入 DXF 文件的程序对其进行设置）
(or colour (setq colour 7))
(or xianxin (setq xianxin "Continuous"))
(entmakex
(list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 2 name)
(cons 70 n70)
(cons 62 colour)
(cons 6 xianxin)
))
)
(defun c:tcgg ()
(setvar "clayer" "0")
(vlax-for lyr (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object)))
(if (zerop (vlax-get lyr 'Plottable))
(vla-put-LayerOn lyr :vlax-false)
)
)
)
(defun hbys(o / i n j)(while (< (1+ (setq i (if (not i) -1 (1+ i)))) (length o))(while (= j (setq j (nth (setq i (1+ i)) o))))(setq n (append n (list j))))(cons (car o) n))
(defun c:tt ()
(princ "请选择复核区域~~")
(setq lst (list))
(setq jh_tc (list))
(setq ss (ssget (list (cons 0 "INSERT"))))
(setq n 0)
(while (< n (sslength ss))
(setq tc_w (cdr (assoc 8 (entget (ssname ss n)))))
(setq wz_bj (cdr (assoc 10 (entget (ssname ss n)))))
(setq bj_dy (cdr(assoc 290 (entget (tblobjname "LAYER" tc_w)))))
(if(= bj_dy 0)
(progn
(vlax-for obj
(vla-item (vla-get-blocks
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(cdr (assoc 2 (entget (ssname ss n))))
)
(setq color (vla-get-color obj)
layer (vla-get-layer obj)
objname (vla-get-objectname obj)
)
(princ "\n对象名称 = ")
(princ objname)
(princ "\n对象图层 = ")
(princ layer)
(princ "\n对象颜色 = ")
(princ color)
;;添加你的操作代码
;;...
(setq jh_tc (append (list layer) jh_tc))
)(setq num 0)
(while(< num (length jh_tc))
(setq bj (cdr(assoc 290 (entget (tblobjname "LAYER" (nth num jh_tc))))))
(if (= bj 1)
(progn(setq lst (append (list (cdr (assoc 2 (entget (ssname ss n))))) lst))
(command "line" (list 0 0 0) wz_bj ""))
)(setq num (+ 1 num)))))
(setq n (+ n 1))
)
(princ)
(setq lst (hbys lst))
(setq nn (length lst))
(setq wztext "是否打印")
(setq n 0)
(while (< n (- nn 1))
(setq wztext (strcat (itoa n) "." (nth n lst) ">>>" wztext))
(setq n (+ 1 n))
)
(alert (strcat "请注意以下图块块名\n" wztext))
)

(setq 
        ;;常用VLA对象、集合 
        *ACAD*  (vlax-get-acad-object) 
        *DOC*   (vla-get-ActiveDocument *ACAD*) 
        *DOCS*  (vla-get-Documents *ACAD*) 
        *MS*    (vla-get-modelSpace *DOC*) 
        *PS*    (vla-get-paperSpace *DOC*) 
        *BLKS*  (vla-get-Blocks *DOC*) 
        *LAYS*  (vla-get-Layers *DOC*) 
        *LTS*   (vla-get-Linetypes *DOC*) 
        *STS*   (vla-get-TextStyles *DOC*) 
        *GRPS*  (vla-get-groups *DOC*) 
        *DIMS*  (vla-get-DimStyles *DOC*) 
        *LOUTS* (vla-get-Layouts *DOC*) 
        *VPS*   (vla-get-Viewports *DOC*) 
        *VS*    (vla-get-Views *DOC*) 
        *DICS*  (vla-get-Dictionaries *DOC*) 
        *Layouts* (vla-get-Layouts *doc*) 
) 
 
 
;;返回所有图层对应的对象名(大写) 
;;返回：((图层名1 对象名1) (图层名2 对象名2)……) 
(defun try-Layer-obj-name (/ ob) 
        (vlax-for each (vla-get-Layers *DOC*) 
                (setq ob(cons(list (vla-get-name each)each)  ob)) 
        ) 
        ob 
) 
 
 
;;返回所有图层的名称(字符串表) 
(defun try-Layer-allname(/ out) 
        (vlax-for obj *LAYS* 
                (setq out (cons (vlax-get-property obj 'Name) out)) 
        ) 
        (reverse out) 
) 
 
;| 
返回所有图层的信息 
(("层名" 状态 颜色 "线型")……) 
状态：1冻结图层 2新视口冻结图层 4锁定…(其他看帮助) 
颜色：负值为隐藏图层 
|; 
(defun try-Layer-Info (/ lst d e1 e2) 
        (while (setq d (tblnext "layer" (null d))) 
                (setq   lst (cons (mapcar 'cdr (cdr d)) lst)    ) 
        ) 
        (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2)))) 
) 
 
;;获取指定图层的图元名 
;;(try-Layer-ent "0") --> <图元名: -64cb388> 
(defun try-Layer-ent (name)(tblobjname "layer" name)) 
 
 
;;打开关闭图层 
;;参数：图层名称表 
(defun try-Layer-On (LayList) 
        (setq LayList(mapcar 'strcase LayList)) 
        (vlax-for each *LAYS* 
                (if (member (strcase (vla-get-name each)) LayList) 
                        (if (vlax-write-enabled-p each) 
                                (vla-put-LayerOn each :vlax-True) 
                        ) 
                ) 
                (vlax-release-object each) 
        ) 
) 
 
 
;;关闭图层 
;;参数：图层名称表 
(defun try-Layer-Off (LayList) 
        (setq LayList(mapcar 'strcase LayList)) 
        (vlax-for each *LAYS* 
                (if (member (strcase (vla-get-name each)) LayList) 
                        (if (vlax-write-enabled-p each) 
                                (vla-put-LayerOn each :vlax-False) 
                        ) 
                ) 
                (vlax-release-object each) 
        ) 
) 
 
;;设置指定图层(列表)不打印 
;;参数1、图层列表 
;;参数2、是否打印（T打印/nil不打印） 
(defun try-Layer-Plot (LayList On-Off) 
        (vlax-for each (vla-get-Layers *DOC*) 
                (if (member (strcase (vla-get-name each)) (mapcar 'strcase LayList)) 
                        (if (vlax-write-enabled-p each) 
                                (if On-Off 
                                        (vla-put-Plottable each :vlax-True) 
                                        (vla-put-Plottable each :vlax-False) 
                                ) 
                        ) 
                ) 
                (vlax-release-object each) 
        ) 
) 
;;;创建一个图层 
;;;参    数1:name:图层名称 
;;;参    数2:colour:颜色默认nil(7) 
;;;参    数3:xianxin:线型默认nil(Continuous) 
;;;参    数4:n70:标志位，默认nil(0)（详见函数内注释） 
;;;示    例: (try-make-layer "abc" nil nil nil) 
(defun try-layer-make (name colour xianxin n70) 
        (or n70 (setq n70 0)) 
        ;标准标记（按位编码值）： 
        ;1 = 冻结图层，否则解冻图层 
        ;2 = 默认情况下在新视口中冻结图层 
        ;4 = 锁定图层 
        ;16 = 如果设置了此位，则表条目外部依赖于外部参照 
        ;32 = 如果同时设置了此位和位 16，则表明已成功融入了外部依赖的外部参照 
        ;64 = 如果设置了此位，则表明在上次编辑图形时，图形中至少有一个图元参照了表条目。（此标志适用于 <a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a> 命令。大多数读取 DXF 文件的程序都可以忽略它，并且无需由写入 DXF 文件的程序对其进行设置） 
        (or colour (setq colour 7)) 
        (or xianxin (setq xianxin "Continuous")) 
        (entmakex 
                (list 
                        '(0 . "LAYER") 
                        '(100 . "AcDbSymbolTableRecord") 
                        '(100 . "AcDbLayerTableRecord") 
                        (cons 2  name) 
                        (cons 70 n70) 
                        (cons 62  colour) 
                        (cons 6  xianxin) 
                )) 
) 
 
 
(defun c:tcgg () 
  (setvar "clayer" "0") 
  (vlax-for lyr  (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))) 
    (if  (zerop (vlax-get lyr 'Plottable)) 
      (vla-put-LayerOn lyr :vlax-false) 
    ) 
  ) 
)       
 
 
(defun hbys(o / i n j)(while (< (1+ (setq i (if (not i) -1 (1+ i)))) (length o))(while (= j (setq j (nth (setq i (1+ i)) o))))(setq n (append n (list j))))(cons (car o) n)) 
(defun c:tt () 
  (princ "请选择复核区域~~") 
  (setq lst (list)) 
  (setq jh_tc (list)) 
  (setq ss (ssget (list (cons 0 "INSERT")))) 
  (setq n 0) 
  (while (< n (sslength ss)) 
    (setq tc_w (cdr (assoc 8 (entget (ssname ss n))))) 
    (setq wz_bj (cdr (assoc 10 (entget (ssname ss n))))) 
    (setq bj_dy (cdr(assoc 290 (entget (tblobjname "LAYER" tc_w))))) 
    (if(= bj_dy 0) 
    (progn 
    (vlax-for obj 
              (vla-item        (vla-get-blocks 
                          (vla-get-ActiveDocument (vlax-get-acad-object)) 
                        ) 
                        (cdr (assoc 2 (entget (ssname ss n)))) 
              ) 
      (setq color   (vla-get-color obj) 
            layer   (vla-get-layer obj) 
            objname (vla-get-objectname obj) 
      ) 
      (princ "\n对象名称 = ") 
      (princ objname) 
      (princ "\n对象图层 = ") 
      (princ layer) 
      (princ "\n对象颜色 = ") 
      (princ color) 
      ;;添加你的操作代码 
      ;;... 
     (setq jh_tc (append (list layer) jh_tc)) 
 
    )(setq num 0) 
    (while(< num (length jh_tc)) 
    (setq bj (cdr(assoc 290 (entget (tblobjname "LAYER" (nth num jh_tc))))))   
    (if        (= bj 1) 
      (progn(setq lst (append (list (cdr (assoc 2 (entget (ssname ss n))))) lst)) 
      (command "line" (list 0 0 0) wz_bj "")) 
    )(setq num (+ 1 num))))) 
    (setq n (+ n 1)) 
  ) 
  (princ) 
  (setq lst (hbys lst)) 
  (setq nn (length lst)) 
  (setq wztext "是否打印") 
  (setq n 0) 
  (while (< n (- nn 1)) 
   (setq wztext (strcat (itoa n) "." (nth n lst) ">>>" wztext)) 
   (setq n (+ 1 n)) 
  ) 
  (alert (strcat  "请注意以下图块块名\n" wztext)) 
)

kozmosovia · 发表于前天 20:46

这种做法意义不大吧？如果一个块分别在可打印图层和不可打印图层插入，那么就没有注意的意义。

最简单的直接把不打印图层冻结，可见即可得的可视化检索核查不比只知道个块名来注意快得多。

qifeifei · 发表于前天 17:46

好的收藏了

zhwc125 · 发表于前天 21:20

谢谢分享，下载收藏！！！！

不一样地设计 · 发表于昨天 00:24

谢谢分享，下载收藏

lxl217114 · 发表于昨天 13:12

kozmosovia 发表于 2025-9-1 20:46
这种做法意义不大吧？如果一个块分别在可打印图层和不可打印图层插入，那么就没有注意的意义。

最简单的 ...

印前检查，很好的功能啊！
如果不小心放错了层，检测到了及时修改到位。

嘒彼小星 · 发表于昨天 17:30

;选中全图不打印对象，由73大佬指导
(defun C:bdy(/ la lay)
  (setq lay"")
  (while(setq la(cdr(assoc 2(tblnext"layer"(not la)))))
(or(=(cdr(assoc 290(entget(TBLOBJNAME"layer"la))))1)
   (setq lay(strcat la","lay)))
)
  (sssetfirst nil(ssget"X"(list(cons 8 lay))))
(princ "\n所有不打印图层的图元已高亮显示。注：不遍历块参照里面的图元，")
(princ)
)

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

[源码] 不打印块检测

点评

浏览过的版块