[日积月累]：修改图元至单色。。。。

eachy · 发表于 2004-6-26 04:41:33

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun ea:Clearcset (/ cset)
(if (not (vl-catch-all-error-p
(setq cset
(vl-catch-all-apply
'vla-item
(list
(vlax-get-property
(vlax-get-property
(vlax-get-acad-object)
'activedocument
)
'selectionsets
)
"CURRENT"
)
)
)
)
)
(vla-delete cset)
)
(princ)
)
(defun c:test (/ chgblkcolor)
(defun chgblkcolor (obj col)
(cond
((= (vla-get-objectname obj) "AcDbBlockReference")
(vlax-for m (vla-item
(vlax-get (vlax-get (vlax-get-acad-object)
'activedocument
)
'Blocks
)
(vla-get-name obj)
)
(if (= (vla-get-objectname m) "AcDbBlockReference")
(chgblkcolor m col)
(vla-put-color m 8)
)
)
)
(t
(vla-put-color obj 8)
)
)
)
(ea:ClearCSet)
(if (ssget)
(vlax-map-collection
(vlax-get
(vlax-get (vlax-get-acad-object) 'activedocument)
'activeselectionset
)
'(lambda (i)
(chgblkcolor i 8)
)
)
)
(princ)
)

(defun ea:Clearcset (/ cset) 
  (if (not (vl-catch-all-error-p 
             (setq cset 
                    (vl-catch-all-apply 
                      'vla-item 
                      (list 
                        (vlax-get-property 
                          (vlax-get-property 
                            (vlax-get-acad-object) 
                            'activedocument 
                          ) 
                          'selectionsets 
                        ) 
                        "CURRENT" 
                      ) 
                    ) 
             ) 
           ) 
      ) 
    (vla-delete cset) 
  ) 
  (princ) 
) 
(defun c:test (/ chgblkcolor) 
  (defun chgblkcolor (obj col) 
    (cond 
      ((= (vla-get-objectname obj) "AcDbBlockReference") 
       (vlax-for m (vla-item 
                     (vlax-get (vlax-get (vlax-get-acad-object) 
                                         'activedocument 
                               ) 
                               'Blocks 
                     ) 
                     (vla-get-name obj) 
                   ) 
         (if (= (vla-get-objectname m) "AcDbBlockReference") 
           (chgblkcolor m col) 
           (vla-put-color m 8) 
         ) 
       ) 
      ) 
      (t 
       (vla-put-color obj 8) 
      ) 
    ) 
  ) 
  (ea:ClearCSet) 
  (if (ssget) 
    (vlax-map-collection 
      (vlax-get 
        (vlax-get (vlax-get-acad-object) 'activedocument) 
        'activeselectionset 
      ) 
      '(lambda (i) 
         (chgblkcolor i 8) 
       ) 
    ) 
  ) 
  (princ) 
)

zhanzujie · 发表于 2004-6-27 08:46:29

在我的机子上,为何这个程序时灵时不灵的
还有改成其他颜色也有问题

陌生人 · 发表于 2004-6-27 11:30:22

用了ClearCSet还是不行？[php]

命令: test
选择对象: 指定对角点: 找到 7 个

选择对象:

错误: AutoCAD: 调用方法 Clear (接口 IAcadSelectionSet) 失败

命令: tst 未知命令“TST”。按 F1 查看帮助。

命令: test
选择对象: 指定对角点: 找到 7 个

选择对象:

错误: AutoCAD: 调用方法 Clear (接口 IAcadSelectionSet) 失败
[/php]

eachy · 发表于 2004-6-27 11:43:29

我这测试没有问题，对 Insert 要进行一次 regen 才可以看到效果

再次试验的确有问题，Undo以后 ActiveSelectionset 会出现另外一种情况，就是有 conut 属性但不能 Clear ，所以 ssget 的没有进入ActiveSelectionset。这样的话 ea:clearcset 可以简化成以下代码就没有问题了。因为要使用新选择集，旧的不管有没有尽管清理一次。

(defun ea:Clearcset (/ cset)
(if (not (vl-catch-all-error-p
(setq cset
(vl-catch-all-apply
'vla-item
(list
(vlax-get-property
(vlax-get-property
(vlax-get-acad-object)
'activedocument
)
'selectionsets
)
"CURRENT"
)
)
)
)
)
(vla-delete cset)
)
(princ)
)

再补充几句，上面的程序仅是为了满足当时改图的需要，能够运行且完成了工作就 OK ，远谈不上完善，比如对属性还要单独改、错误处理、标记开始与结束等等。

lsjjm · 发表于 2004-6-28 04:33:09

修改图元至单色, 以前有讨论... 可能比此更简洁. 不知斑竹的还有什么特殊功能?

eachy · 发表于 2004-6-28 07:54:26

最初由 lsjjm 发布
[B]修改图元至单色, 以前有讨论... 可能比此更简洁. 不知斑竹的还有什么特殊功能? [/B]

1 对嵌套图块处理
2 ActiveSelectionSet 的Bug处理

LUCAS · 发表于 2004-6-29 09:07:06

;;轉貼(作者:......忘了)
;;To change all entities color you've seen the rest, to change block entities
;;color - use this quick and dirty code (A2k)...
;;對屬性還要單獨改.......最後要REGEN。
(defun CHGBLKENTCOL (COL / BLKCOL)
(setq BLKCOL (vla-get-blocks
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(vlax-for OBJ BLKCOL
(if (and
(= (vla-get-islayout OBJ) :vlax-false)
(= (vla-get-isxref OBJ) :vlax-false)
)
(CHGCOL OBJ BLKCOL COL)
)
)
(princ)
)
(defun CHGCOL (OBJ BCL COL)
(vlax-for ENT OBJ
(if (= (vla-get-objectname ENT) "AcDbBlockReference")
(CHGCOL (vla-item BCL (vla-get-name ENT)) BCL COL)
;;(if (vlax-property-available-p ENT 'COLOR)
(vla-put-color ENT COL) ;acbylayer)
;;)
)
)
)

;;轉貼(作者:......忘了) 
;;To change all entities color you've seen the rest, to change block entities 
;;color - use this quick and dirty code (A2k)... 
;;對屬性還要單獨改.......最後要REGEN。 
(defun CHGBLKENTCOL (COL / BLKCOL) 
  (setq        BLKCOL (vla-get-blocks 
                 (vla-get-activedocument 
                   (vlax-get-acad-object) 
                 ) 
               ) 
  ) 
  (vlax-for OBJ        BLKCOL 
    (if        (and 
          (= (vla-get-islayout OBJ) :vlax-false) 
          (= (vla-get-isxref OBJ) :vlax-false) 
        ) 
      (CHGCOL OBJ BLKCOL COL) 
    ) 
  ) 
  (princ) 
) 
 
(defun CHGCOL (OBJ BCL COL) 
  (vlax-for ENT        OBJ 
    (if        (= (vla-get-objectname ENT) "AcDbBlockReference") 
      (CHGCOL (vla-item BCL (vla-get-name ENT)) BCL COL) 
      ;;(if (vlax-property-available-p ENT 'COLOR) 
      (vla-put-color ENT COL)                ;acbylayer) 
      ;;) 
    ) 
  ) 
)

aeo · 发表于 2004-6-30 01:44:01

最初由 eachy 发布
[B]我这测试没有问题，对 Insert 要进行一次 regen 才可以看到效果

再次试验的确有问题，Undo以后 ActiveSelectionset 会出现另外一种情况，就是有 conut 属性但不能 Clear ，所以 ssget 的没有进入ActiveSelections... [/B]

你这个方法是没办法去掉前一个选集的

还可以用"p"得到

陌生人 · 发表于 2004-6-30 02:11:47

哦？能说说原理么？
哦～
不过，处理出错是针对当前选择集，前一个选集与程序结构本身没什么大的关系，消除与否并不影响程序运行的效果吧。

LUCAS · 发表于 2004-6-30 08:12:11

;;(vlax-for obj (activeselectionset) (print obj)(princ))
;;activeselectionset相同於autocad中的"P"
;;如(ssget)為nil並不影嚮activeselectionset
;;BY 龍龍仔(LUCAS)
(defun ACTIVESELECTIONSET (/ SSOBJ)
(vl-catch-all-apply
'vla-delete
(list
(vl-catch-all-apply
'vla-item
(list (vla-get-selectionsets
(vla-get-activedocument (vlax-get-acad-object))
)
"CURRENT"
)
)
)
)
(setq SSOBJ (vla-get-activeselectionset
(vla-get-activedocument (vlax-get-acad-object))
)
)
(if (/= (vla-get-count SSOBJ) 0)
SSOBJ
NIL
)
)

账号		自动登录	找回密码
密码			立即注册

[日积月累]：修改图元至单色。。。。

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块