请求修改

刘炎华

如果改变颜色的对象要自己选择,要修改哪里呢?
以下是所有的图都改颜色了。
------------------------------------------
(defun c:resetcolor (/ c)
  (setq c  8 )

  (if c
    (vlax-for block (vla-get-blocks
                      (vla-get-activedocument (vlax-get-acad-object))
                    )
      (vlax-for        ent block
        (vl-catch-all-apply 'vla-put-color (list ent c))

        ;; 增加对参照中属性的处理
        (if (and (= "AcDbBlockReference" (vla-get-objectname ent))
                 (= :vlax-true (vla-get-hasattributes ent))
            )
          (foreach att (vlax-safearray->list
                         (vlax-variant-value (vla-getattributes ent))
                       )
            (vla-put-color att c)
          )
        )
      )
    )
  )
  (princ)
)

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)
)

magicheno

(DEFUN C:c1 (/ pnam)
  (if (setq pnam (ssget))
    (COMMAND "chprop" pnam "" "c" "1" "")
  )
  (PRINC)
)


以此类推

lee50310

改第一行  (setq c  8 )   改成  (setq c (getint "\n 输入颜色值: "))
   

刘炎华

您好!
不用输入颜色值的
想要的是自己选择对象去修改颜色,不是把整个图的对象都改变颜色.
是不是各这个有关?   vl-catch-all-apply

yshf

(defun c:resetcolor (/ c)
  (setq cmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq Document (vla-get-ActiveDocument (vlax-get-acad-object)))
  (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 (and (= "AcDbBlockReference" (vla-get-objectname Obj))
                  (= :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 Document)
  (setvar "cmdecho" cmd)
  (princ)
)

lee50310

;;選擇一对象改變顏色
(defun c:ch1 (/ c)
  (setq c 3 )  ;指定顏色 綠色
  (setq en (car (entsel)))
  (command "chprop" en "" "c" c )
)

tryhi

(defun c:tt (/ c en i ins names ojb ss)
  (setq c  8 )
        (setq ss(ssget))
        (setq i -1 names nil)
        (while (setq en(ssname ss(setq i(1+ i))))
                (setq ojb (vlax-ename->vla-object en))
                (if(/= (cdr (assoc 0 (entget en )))"INSERT")
                        (vla-put-color ojb c)
                        (progn
                                (setq ins(cdr (assoc 2 (entget en ))))
                                (if(member ins names)nil(setq names(cons ins names)))
                                (if (= :vlax-true (vla-get-hasattributes ojb))
                                        (foreach att (vlax-safearray->list
                         (vlax-variant-value (vla-getattributes ojb))
                       )
            (vla-put-color att c)
          )
                                )
                        )
                )
        )
        (vlax-for block (vla-get-blocks
                                                                                (vla-get-activedocument (vlax-get-acad-object))
                                                                        )
                (if(member (vlax-get-property block 'Name)names)
                        (vlax-for ent block
                                (vl-catch-all-apply 'vla-put-color (list ent c))
                        )
                )
        )
  (princ)
)

刘炎华

yshf 发表于 2020-4-2 09:24
;或者
(defun c:resetcolor (/ c)
  (setq cmd (getvar "cmdecho"))

可以了!非常感谢!