求快速修改所有图元颜色的源码

yshf

(defun c:resetcolor (/ c)
  (setq cmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq Document (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq Blocks (vla-get-blocks Document))
  (vla-StartUndoMark Document)

  (setq c  8 )

  (If (progn
          (princ "\n请选择要更改颜色的图元:")
          (setq ssa (ssget))
      )
      (vlax-for Obj (vla-get-ActiveSelectionSet Document)
         (vl-catch-all-apply 'vla-put-color (list Obj c))

         (if (= "AcDbBlockReference" (vla-get-objectname Obj))
             (progn
                 (vlax-for BlkObj (vla-item Blocks (vla-get-name Obj))
                       (vl-catch-all-apply 'vla-put-color (list BlkObj c))
                 )
                 (if (= :vlax-true (vla-get-hasattributes Obj))
                     (foreach AttObj (vlax-safearray->list
                                           (vlax-variant-value (vla-getattributes Obj))
                                     )
                         (vl-catch-all-apply 'vla-put-color (list AttObj c))
                     )
                 )
             )
         )
      )
  )
  (vla-EndUndoMark Document)
  (vlax-release-object Blocks)
  (vlax-release-object Document)
  (setvar "cmdecho" cmd)
  (princ)
)

BUBUBA918

vectra 发表于 2017-9-25 09:03
增加了对属性的支持
不需要选择颜色时可将(setq c (acad_colordlg 8))这行修改为(setq c 8)

能否加入可以选择图元

xzklk

非常感谢

石井鱼

非常好用