[LISP程序]：改块颜色的LSP。

userzhluserzhl · 发表于 2006-9-4 18:14:18

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

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

×

(defun c:blk_col( / blk blkref blocks doc ent name ss n clo)
(vl-load-com)
(princ "\n选要改颜色的块: ")
(setq ss (ssget '((0 . "INSERT")))
n (sslength ss)
)
(while (and (setq BLK (ssname ss (setq n (1- n))))
(setq BLKREF (vlax-ename->vla-object BLK))
(not(and(/= (vla-get-objectname BLKREF) "AcDbBlockReference")
(princ"\n不是块:"))
)
(setq clo (acad_colordlg 7))
(setq name(vla-get-name BLKREF))
)
(progn
(command"undo""group")
(setq DOC (vla-get-activedocument (vlax-get-acad-object))
BLOCKS (vla-get-blocks doc)
blk (vla-item BLOCKS name)
)
(vlax-for ENT blk
(vla-put-layer ent "图块")
(vla-put-color ent clo)
)
(vla-regen doc acActiveViewport)
(vlax-release-object blk)
(vlax-release-object BLOCKS)
(vlax-release-object DOC)
(command"undo""end")
)
)
(princ"\nUndo后请regen.")
(princ))

(defun c:blk_col( / blk blkref blocks doc ent name ss n clo) 
 (vl-load-com) 
  (princ "\n选要改颜色的块: ") 
(setq ss (ssget '((0 . "INSERT"))) 
      n  (sslength ss) 
) 
  (while (and (setq BLK     (ssname ss (setq n (1- n)))) 
   (setq BLKREF  (vlax-ename->vla-object BLK)) 
   (not(and(/= (vla-get-objectname BLKREF) "AcDbBlockReference") 
       (princ"\n不是块:")) 
    ) 
       (setq clo (acad_colordlg 7)) 
   (setq name(vla-get-name BLKREF)) 
      ) 
    (progn 
          (command"undo""group") 
          (setq DOC     (vla-get-activedocument (vlax-get-acad-object)) 
                BLOCKS  (vla-get-blocks doc) 
         blk     (vla-item BLOCKS name) 
          ) 
           (vlax-for ENT blk 
             (vla-put-layer ent "图块") 
             (vla-put-color ent clo) 
           ) 
        (vla-regen doc acActiveViewport) 
        (vlax-release-object blk) 
        (vlax-release-object BLOCKS) 
        (vlax-release-object DOC) 
        (command"undo""end") 
         
     ) 
  ) 
  (princ"\nUndo后请regen.") 
(princ))

这个程序只能单选，而且需要选色——可不可以改成这样：

不用多次选色(即：可同时选择若干个块，无论是多重块匿名块嵌套块还是属性块)，颜色自动改为8号色(不需选色)，并把其图层(块内的所有图元)自动归到"图块"层。

crtrccrt · 发表于 2006-9-26 11:55:49

(defun c:iys ( / blk blkref blocks doc ent name ss n clo)
 (if (> (atoi (substr (getvar "acadver") 1 2)) 14)
(progn
 (VL-LOAD-COM)
 (setq clo (acad_colordlg 7))
 (while (and
 (princ (strcat "\n 选要要颜色改为[" (itoa clo) "]的块: <退出> "))
 (setq ss (ssget (list (cons 0 "insert"))))
 )
 (setq n (sslength ss))
 (command "_.undo" "be")
 (repeat n
 (setq blk (ssname ss (setq n (1- n))))
 (setq blkref (vlax-ename->vla-object blk))
 (setq name (vla-get-name blkref))
 (setq doc (vla-get-activedocument (vlax-get-acad-object))
 blocks (vla-get-blocks doc)
 blk (vla-item blocks name)
 )
 (vlax-for ent blk (vla-put-color ent clo))
 (vla-regen doc acactiveviewport)
 (vlax-release-object blk)
 (vlax-release-object blocks)
 (vlax-release-object doc)
 (vlax-release-object blkref)
 );;;repeat;
 (command "_.undo" "e")
 );;;while;
);;;progn;
(progn
 (princ "\n **无法在ACAD14及以下版本中运行(VL-LOAD-COM)!!!请在ACAD2000及以上版本中运行!!!")
);;;progn;
 );;;if;
 (gc)(redraw)(princ)
)

wl1221 · 发表于 2006-9-25 22:32:59

是啊建议不错不知道哪位大虾帮改一下

zxdvip · 发表于 2006-11-16 21:25:20

真乃高手也，找了很久的程序

KLDC · 发表于 2006-11-17 12:02:08

选色的时候，最好能直接参照图中的图元，不要弹对话框。

formz · 发表于 2006-11-18 22:24:52

砍套的多層次BLOCK沒法改色

qjcpj · 发表于 2006-11-19 09:06:20

最初由 formz 发布
[B]砍套的多層次BLOCK沒法改色 [/B]

改为递归调用就可以了！

冷冷的风 · 发表于 2006-11-21 11:14:31

怎么用啊.

zxdvip · 发表于 2006-11-22 15:02:19

此程序在2007中很好用，在2008中总是崩溃，估计是2008的问题，我已经告诉AUTODESK了

jx2008 · 发表于 2008-10-9 10:30:56

已经有完善的程序出来了。

kainanun · 发表于 2008-10-10 21:57:33

果然好东西

ljl2482 · 发表于 2015-6-5 09:55:07

qjcpj 发表于 2006-11-19 09:06
改为递归调用就可以了！

怎样该递归调用？

gannaijun · 发表于 2019-11-29 23:16:46

crtrccrt 发表于 2006-9-26 11:55
(defun c:iys ( / blk blkref blocks doc ent name ss n clo)
(if (> (atoi (substr (getvar "acadver") ...

棒棒棒！！！！！！！

gannaijun · 发表于 2019-11-29 23:26:24

crtrccrt 发表于 2006-9-26 11:55
(defun c:iys ( / blk blkref blocks doc ent name ss n clo)
(if (> (atoi (substr (getvar "acadver") ...

棒棒棒！！！！！！！

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

[LISP程序]：改块颜色的LSP。

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

相关帖子

点评