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

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

  2. (setq
  3.         ;;常用VLA对象、集合
  4.         *ACAD*  (vlax-get-acad-object)
  5.         *DOC*   (vla-get-ActiveDocument *ACAD*)
  6.         *DOCS*  (vla-get-Documents *ACAD*)
  7.         *MS*    (vla-get-modelSpace *DOC*)
  8.         *PS*    (vla-get-paperSpace *DOC*)
  9.         *BLKS*  (vla-get-Blocks *DOC*)
  10.         *LAYS*  (vla-get-Layers *DOC*)
  11.         *LTS*   (vla-get-Linetypes *DOC*)
  12.         *STS*   (vla-get-TextStyles *DOC*)
  13.         *GRPS*  (vla-get-groups *DOC*)
  14.         *DIMS*  (vla-get-DimStyles *DOC*)
  15.         *LOUTS* (vla-get-Layouts *DOC*)
  16.         *VPS*   (vla-get-Viewports *DOC*)
  17.         *VS*    (vla-get-Views *DOC*)
  18.         *DICS*  (vla-get-Dictionaries *DOC*)
  19.         *Layouts* (vla-get-Layouts *doc*)
  20. )


  23. ;;返回所有图层对应的对象名(大写)
  24. ;;返回：((图层名1 对象名1) (图层名2 对象名2)……)
  25. (defun try-Layer-obj-name (/ ob)
  26.         (vlax-for each (vla-get-Layers *DOC*)
  27.                 (setq ob(cons(list (vla-get-name each)each)  ob))
  28.         )
  29.         ob
  30. )


  33. ;;返回所有图层的名称(字符串表)
  34. (defun try-Layer-allname(/ out)
  35.         (vlax-for obj *LAYS*
  36.                 (setq out (cons (vlax-get-property obj 'Name) out))
  37.         )
  38.         (reverse out)
  39. )

  41. ;|
  42. 返回所有图层的信息
  43. (("层名" 状态 颜色 "线型")……)
  44. 状态：1冻结图层 2新视口冻结图层 4锁定…(其他看帮助)
  45. 颜色：负值为隐藏图层
  46. |;
  47. (defun try-Layer-Info (/ lst d e1 e2)
  48.         (while (setq d (tblnext "layer" (null d)))
  49.                 (setq   lst (cons (mapcar 'cdr (cdr d)) lst)    )
  50.         )
  51.         (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2))))
  52. )

  54. ;;获取指定图层的图元名
  55. ;;(try-Layer-ent "0") --> <图元名: -64cb388>
  56. (defun try-Layer-ent (name)(tblobjname "layer" name))


  59. ;;打开关闭图层
  60. ;;参数：图层名称表
  61. (defun try-Layer-On (LayList)
  62.         (setq LayList(mapcar 'strcase LayList))
  63.         (vlax-for each *LAYS*
  64.                 (if (member (strcase (vla-get-name each)) LayList)
  65.                         (if (vlax-write-enabled-p each)
  66.                                 (vla-put-LayerOn each :vlax-True)
  67.                         )
  68.                 )
  69.                 (vlax-release-object each)
  70.         )
  71. )


  74. ;;关闭图层
  75. ;;参数：图层名称表
  76. (defun try-Layer-Off (LayList)
  77.         (setq LayList(mapcar 'strcase LayList))
  78.         (vlax-for each *LAYS*
  79.                 (if (member (strcase (vla-get-name each)) LayList)
  80.                         (if (vlax-write-enabled-p each)
  81.                                 (vla-put-LayerOn each :vlax-False)
  82.                         )
  83.                 )
  84.                 (vlax-release-object each)
  85.         )
  86. )

  88. ;;设置指定图层(列表)不打印
  89. ;;参数1、图层列表
  90. ;;参数2、是否打印（T打印/nil不打印）
  91. (defun try-Layer-Plot (LayList On-Off)
  92.         (vlax-for each (vla-get-Layers *DOC*)
  93.                 (if (member (strcase (vla-get-name each)) (mapcar 'strcase LayList))
  94.                         (if (vlax-write-enabled-p each)
  95.                                 (if On-Off
  96.                                         (vla-put-Plottable each :vlax-True)
  97.                                         (vla-put-Plottable each :vlax-False)
  98.                                 )
  99.                         )
  100.                 )
  101.                 (vlax-release-object each)
  102.         )
  103. )
  104. ;;;创建一个图层
  105. ;;;参    数1:name:图层名称
  106. ;;;参    数2:colour:颜色默认nil(7)
  107. ;;;参    数3:xianxin:线型默认nil(Continuous)
  108. ;;;参    数4:n70:标志位，默认nil(0)（详见函数内注释）
  109. ;;;示    例: (try-make-layer "abc" nil nil nil)
  110. (defun try-layer-make (name colour xianxin n70)
  111.         (or n70 (setq n70 0))
  112.         ;标准标记（按位编码值）：
  113.         ;1 = 冻结图层，否则解冻图层
  114.         ;2 = 默认情况下在新视口中冻结图层
  115.         ;4 = 锁定图层
  116.         ;16 = 如果设置了此位，则表条目外部依赖于外部参照
  117.         ;32 = 如果同时设置了此位和位 16，则表明已成功融入了外部依赖的外部参照
  118.         ;64 = 如果设置了此位，则表明在上次编辑图形时，图形中至少有一个图元参照了表条目。（此标志适用于 AutoCAD 命令。大多数读取 DXF 文件的程序都可以忽略它，并且无需由写入 DXF 文件的程序对其进行设置）
  119.         (or colour (setq colour 7))
  120.         (or xianxin (setq xianxin "Continuous"))
  121.         (entmakex
  122.                 (list
  123.                         '(0 . "LAYER")
  124.                         '(100 . "AcDbSymbolTableRecord")
  125.                         '(100 . "AcDbLayerTableRecord")
  126.                         (cons 2  name)
  127.                         (cons 70 n70)
  128.                         (cons 62  colour)
  129.                         (cons 6  xianxin)
  130.                 ))
  131. )


  134. (defun c:tcgg ()
  135.   (setvar "clayer" "0")
  136.   (vlax-for lyr  (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object)))
  137.     (if  (zerop (vlax-get lyr 'Plottable))
  138.       (vla-put-LayerOn lyr :vlax-false)
  139.     )
  140.   )
  141. )      


  144. (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))
  145. (defun c:tt ()
  146.   (princ "请选择复核区域~~")
  147.   (setq lst (list))
  148.   (setq jh_tc (list))
  149.   (setq ss (ssget (list (cons 0 "INSERT"))))
  150.   (setq n 0)
  151.   (while (< n (sslength ss))
  152.     (setq tc_w (cdr (assoc 8 (entget (ssname ss n)))))
  153.     (setq wz_bj (cdr (assoc 10 (entget (ssname ss n)))))
  154.     (setq bj_dy (cdr(assoc 290 (entget (tblobjname "LAYER" tc_w)))))
  155.     (if(= bj_dy 0)
  156.     (progn
  157.     (vlax-for obj
  158.               (vla-item        (vla-get-blocks
  159.                           (vla-get-ActiveDocument (vlax-get-acad-object))
  160.                         )
  161.                         (cdr (assoc 2 (entget (ssname ss n))))
  162.               )
  163.       (setq color   (vla-get-color obj)
  164.             layer   (vla-get-layer obj)
  165.             objname (vla-get-objectname obj)
  166.       )
  167.       (princ "\n对象名称 = ")
  168.       (princ objname)
  169.       (princ "\n对象图层 = ")
  170.       (princ layer)
  171.       (princ "\n对象颜色 = ")
  172.       (princ color)
  173.       ;;添加你的操作代码
  174.       ;;...
  175.      (setq jh_tc (append (list layer) jh_tc))

  177.     )(setq num 0)
  178.     (while(< num (length jh_tc))
  179.     (setq bj (cdr(assoc 290 (entget (tblobjname "LAYER" (nth num jh_tc))))))  
  180.     (if        (= bj 1)
  181.       (progn(setq lst (append (list (cdr (assoc 2 (entget (ssname ss n))))) lst))
  182.       (command "line" (list 0 0 0) wz_bj ""))
  183.     )(setq num (+ 1 num)))))
  184.     (setq n (+ n 1))
  185.   )
  186.   (princ)
  187.   (setq lst (hbys lst))
  188.   (setq nn (length lst))
  189.   (setq wztext "是否打印")
  190.   (setq n 0)
  191.   (while (< n (- nn 1))
  192.    (setq wztext (strcat (itoa n) "." (nth n lst) ">>>" wztext))
  193.    (setq n (+ 1 n))
  194.   )
  195.   (alert (strcat  "请注意以下图块块名\n" wztext))
  196. )





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

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

网友答: 好的 收藏了

网友答: 谢谢分享，下载收藏！！！！

网友答: 谢谢分享，下载收藏

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

最简单的 ...

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

网友答: ;选中全图不打印对象，由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)
)

网友答:
嘒彼小星 发表于 2025-9-2 17:30
;选中全图不打印对象，由73大佬指导
(defun C:bdy(/ la lay)
  (setq lay"")

这么精简的代码么？谢谢分享

网友答:
lxl217114 发表于 2025-9-4 08:42
这么精简的代码么？谢谢分享

看明白哦 是选中不打印的图层的所有对象。不会遍历块里面的图元

网友答:
嘒彼小星 发表于 2025-9-2 17:30
;选中全图不打印对象，由73大佬指导
(defun C:bdy(/ la lay)
  (setq lay"")

  代码精简，功能强大
  • 上一篇：LISP陷阱与缺陷
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025