请求修改

刘炎华 发表于 2020-4-1 23:39:59

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

(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 发表于 2020-4-1 23:40:00

;或者
(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 c8 )

(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 发表于 2020-4-2 01:47:39

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

以此类推

lee50310 发表于 2020-4-2 07:01:04

本帖最后由 lee50310 于 2020-4-2 09:50 编辑

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

刘炎华 发表于 2020-4-2 07:47:06

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

yshf 发表于 2020-4-2 09:14:45

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

(setq c8 )

(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 发表于 2020-4-2 09:45:21

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

tryhi 发表于 2020-4-2 11:02:05

(defun c:tt (/ c en i ins names ojb ss)
(setq c8 )
(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)
)

刘炎华 发表于 2020-4-2 23:12:49

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

可以了!非常感谢!

页: [1]

明经CAD社区's Archiver

请求修改