[求助]图块改层

zazhz123

KO你 发表于 2019-12-12 18:59
块内的图层，颜色，线宽处理
快捷键  bb  块内实体处理
(vl-load-com)

挺好用的，但是能选择几个批量一起改吗

KO你

zazhz123 发表于 2022-3-31 16:21
挺好用的，但是能选择几个批量一起改吗

你可以把多个对象组成一个块来弄，再分解开就行了，技巧方法有时比工具实用哈

zazhz123

KO你 发表于 2022-4-13 00:28
你可以把多个对象组成一个块来弄，再分解开就行了，技巧方法有时比工具实用哈

谢谢热心的您指导。

llj20220606

非常好用，非常感谢

wz1551107

zazhz123 发表于 2022-3-31 16:21
挺好用的，但是能选择几个批量一起改吗

能批量操作，图层选择一个实体提取图层
(vl-load-com)

(defun select-layer-from-entity (/ ent ename layername)
  (princ "\n请选择一个图元，用于提取目标图层：")
  (setq ent (entsel))
  (if ent
    (progn
      (setq ename (vlax-ename->vla-object (car ent)))
      (setq layername (vla-get-layer ename))
      layername
    )
    (progn
      (princ "\n未选中有效对象，操作取消。")
      nil
    )
  )
)

(defun select-color ()
  (acad_colordlg 256)
)

(defun confirm (msg default / rt)
  (initget "Y D ")
  (setq rt (getkword (strcat msg " <" default ">: ")))
  (if (or (null rt) (= rt default)) t nil)
)

(defun walk (blk layerName colorValue lwFlag /)
  (vlax-for x blk
    (if (= "AcDbBlockReference" (vla-get-objectname x))
      (walk
        (vla-item
          (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
          (vla-get-name x))
        layerName colorValue lwFlag
      )
    )

    (if layerName
      (vla-put-layer x layerName)
    )

    (if colorValue
      (vla-put-color x colorValue)
    )

    (if lwFlag
      (progn
        (vla-put-lineweight x -1)
        (if (= "AcDbPolyline" (vla-get-objectname x))
          (vla-put-constantwidth x 0.0)
        )
      )
    )
  )
)

(defun c:bb (/ ss doc blocks i blk blkname layerName colorValue lwFlag)
  (setq doc    (vla-get-activedocument (vlax-get-acad-object))
        blocks (vla-get-blocks doc)
        ss     (ssget '((0 . "INSERT")))
  )

  (if ss
    (progn
      ;; 图层通过选中图元提取
      (setq layerName (select-layer-from-entity))
      (if layerName
        (progn
          (setq colorValue (select-color))
          (setq lwFlag (confirm "是否将线宽重置为默认？ [是(Y)/否(D)]" "Y"))

          (repeat (setq i (sslength ss))
            (setq blk     (vlax-ename->vla-object (ssname ss (setq i (1- i))))
                  blkname (vla-get-name blk))
            (if (not (vlax-property-available-p blk 'path))
              (walk (vla-item blocks blkname) layerName colorValue lwFlag)
            )
          )
          (command "_.regen")
        )
        (princ "\n图层提取失败，操作终止。")
      )
    )
    (princ "\n未选中任何块对象。")
  )
  (princ)
)

wz1551107

按照大神思路修改批量操作，图层为选择一个实体提取图层名，有乱码的保存成ANSI的txt，再修改为lsp
(vl-load-com)

(defun select-layer-from-entity (/ ent ename layername)
  (princ "\n请选择一个图元，用于提取目标图层：")
  (setq ent (entsel))
  (if ent
    (progn
      (setq ename (vlax-ename->vla-object (car ent)))
      (setq layername (vla-get-layer ename))
      layername
    )
    (progn
      (princ "\n未选中有效对象，操作取消。")
      nil
    )
  )
)

(defun select-color ()
  (acad_colordlg 256)
)

(defun confirm (msg default / rt)
  (initget "Y D ")
  (setq rt (getkword (strcat msg " <" default ">: ")))
  (if (or (null rt) (= rt default)) t nil)
)

(defun walk (blk layerName colorValue lwFlag /)
  (vlax-for x blk
    (if (= "AcDbBlockReference" (vla-get-objectname x))
      (walk
        (vla-item
          (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
          (vla-get-name x))
        layerName colorValue lwFlag
      )
    )

    (if layerName
      (vla-put-layer x layerName)
    )

    (if colorValue
      (vla-put-color x colorValue)
    )

    (if lwFlag
      (progn
        (vla-put-lineweight x -1)
        (if (= "AcDbPolyline" (vla-get-objectname x))
          (vla-put-constantwidth x 0.0)
        )
      )
    )
  )
)

(defun c:bb (/ ss doc blocks i blk blkname layerName colorValue lwFlag)
  (setq doc    (vla-get-activedocument (vlax-get-acad-object))
        blocks (vla-get-blocks doc)
        ss     (ssget '((0 . "INSERT")))
  )

  (if ss
    (progn
      ;; 图层通过选中图元提取
      (setq layerName (select-layer-from-entity))
      (if layerName
        (progn
          (setq colorValue (select-color))
          (setq lwFlag (confirm "是否将线宽重置为默认？ [是(Y)/否(D)]" "Y"))

          (repeat (setq i (sslength ss))
            (setq blk     (vlax-ename->vla-object (ssname ss (setq i (1- i))))
                  blkname (vla-get-name blk))
            (if (not (vlax-property-available-p blk 'path))
              (walk (vla-item blocks blkname) layerName colorValue lwFlag)
            )
          )
          (command "_.regen")
        )
        (princ "\n图层提取失败，操作终止。")
      )
    )
    (princ "\n未选中任何块对象。")
  )
  (princ)
)