重置选定块内对象的图层、颜色、线宽属性（更新）

vectra · 发表于 2015-5-12 10:38

本帖最后由 vectra 于 2015-5-12 14:22 编辑

(vl-load-com)
(defun c:db (/ obj blk)
(defun confirm (msg default / rt)
(initget "Y N ")
(if (null (setq rt (getkword (strcat msg " <" default ">:"))))
(setq rt default)
)
(if (= "Y" rt)
t
nil
)
)
(defun walk (blk setlayer setcolor setlw /)
(vlax-for x blk
(if (= "AcDbBlockReference" (vla-get-objectname x))
(walk (vla-item (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
(vla-get-name x)
)
setlayer
setcolor
setlw
)
)
(if setlayer
(vla-put-layer x "0")
)
(if setcolor
(vla-put-color x acbylayer)
)
(if setlw
(progn
(vla-put-lineweight x -1)
(if (= "AcDbPolyline" (vla-get-objectname x))
(vla-put-constantwidth x 0.0)
)
)
)
)
)
(setq obj (ace-entsel "\n选择块:" nil "INSERT")
blk (vla-item (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
(vla-get-name (vlax-ename->vla-object (car obj)))
)
)
(walk blk
(confirm "重置图元图层为\"0\" [是(Y)/否(N)]" "Y")
(confirm "重置图元颜色为随层 [是(Y)/否(N)]" "Y")
(confirm "重置图元线宽默认或零 [是(Y)/否(N)]" "Y")
)
(command ".regen")
(princ)
)
(defun ace-entsel (msg kword filter / ent)
(while (null ent)
(if kword
;; 处理自定义INITGET参数
(initget kword)
;; return empty string ("") if enter key or right button down
(initget " ")
)
(setq ent (entsel msg))
(cond
((null ent)
(princ "未选择对象。")
)
((= (type ent) 'list)
(if (and filter
(not (wcmatch (ace-getval 0 (car ent)) filter))
)
(progn
(princ "选择对象已被过滤。")
(setq ent nil)
)
)
)
)
)
ent
)
(defun ace-getval (key ename)
(cdr (assoc key (entget ename)))
)

(vl-load-com) 
(defun c:db (/ obj blk) 
  (defun confirm (msg default / rt) 
    (initget "Y N ") 
    (if        (null (setq rt (getkword (strcat msg " <" default ">:")))) 
      (setq rt default) 
    ) 
    (if        (= "Y" rt) 
      t 
      nil 
    ) 
  ) 
 
  (defun walk (blk setlayer setcolor setlw /) 
    (vlax-for x        blk 
      (if (= "AcDbBlockReference" (vla-get-objectname x)) 
        (walk (vla-item        (vla-get-blocks 
                          (vla-get-activedocument (vlax-get-acad-object)) 
                        ) 
                        (vla-get-name x) 
              ) 
              setlayer 
              setcolor 
              setlw 
        ) 
      ) 
 
      (if setlayer 
        (vla-put-layer x "0") 
      ) 
 
      (if setcolor 
        (vla-put-color x acbylayer) 
      ) 
 
      (if setlw 
        (progn 
          (vla-put-lineweight x -1) 
          (if (= "AcDbPolyline" (vla-get-objectname x)) 
            (vla-put-constantwidth x 0.0) 
          ) 
        ) 
      ) 
    ) 
  ) 
 
  (setq        obj (ace-entsel "\n选择块:" nil "INSERT") 
        blk (vla-item (vla-get-blocks 
                        (vla-get-activedocument (vlax-get-acad-object)) 
                      ) 
                      (vla-get-name (vlax-ename->vla-object (car obj))) 
            ) 
  ) 
  (walk        blk 
        (confirm "重置图元图层为\"0\" [是(Y)/否(N)]" "Y") 
        (confirm "重置图元颜色为随层 [是(Y)/否(N)]" "Y") 
        (confirm "重置图元线宽默认或零 [是(Y)/否(N)]" "Y") 
  ) 
  (command ".regen") 
  (princ) 
) 
 
(defun ace-entsel (msg kword filter / ent) 
  (while (null ent) 
    (if        kword 
      ;; 处理自定义INITGET参数 
      (initget kword) 
 
      ;; return empty string ("") if enter key or right button down 
      (initget " ") 
    ) 
 
    (setq ent (entsel msg)) 
 
    (cond 
      ((null ent) 
       (princ "未选择对象。") 
      ) 
 
      ((= (type ent) 'list) 
       (if (and        filter 
                (not (wcmatch (ace-getval 0 (car ent)) filter)) 
           ) 
         (progn 
           (princ "选择对象已被过滤。") 
           (setq ent nil) 
         ) 
       ) 
      ) 
    ) 
  ) 
  ent 
) 
 
(defun ace-getval (key ename) 
  (cdr (assoc key (entget ename))) 
)

jkop · 发表于 2023-8-4 11:28

测试可用，主要是回车三次比较繁琐，收藏！

xiaocaiji · 发表于 2022-4-28 10:50

命令: ; 错误: 输入中含有多余的闭括号

/fendou结构绘图 · 发表于 2018-9-3 14:14

正在找这LSP，回车三次好象是有点麻烦

自贡黄明儒 · 发表于 2015-5-12 10:50

不断输送Y or N是不是很累

vectra · 发表于 2015-5-12 10:55

自贡黄明儒发表于 2015-5-12 10:50
不断输送Y or N是不是很累

我原来一个版本就是一键重置的，但是后来发现有些块还是需要有个选项控制一下。

反正我是一直空格、空格、空格就好了

自贡黄明儒 · 发表于 2015-5-12 11:11

vectra 发表于 2015-5-12 10:55
我原来一个版本就是一键重置的，但是后来发现有些块还是需要有个选项控制一下。

反正我是一直空格、空 ...

我觉得有2个以上的选项，还是对话框比较好些。

kwok · 发表于 2015-5-12 13:26

本帖最后由 kwok 于 2015-5-12 13:27 编辑

提示缺少ace-getval
把ace-entsel去掉换成entsel冒似也能用，没了过滤.

xyp1964 · 发表于 2015-5-12 14:21

yjc532 · 发表于 2015-5-14 18:25

如何加载xcad.vlx？？加载后显示一个对话框，不知道怎么使用，请指教，我是新手

yjc532 · 发表于 2015-5-15 19:45

我测试了一下楼主和6楼的程序：
对于楼主的程序：执行完后就能得到效果，而6楼的需要重生成（re）才能得到效果
既然楼主已经考虑了其他情况，就应该在选择 N 的情况下，进一步对属性进行修改（比如颜色改为什么，线型改为什么等等）就更完美了。

我是初学者，正在琢磨学习点东西。指手画脚之处还请高手多多包涵。

shasow · 发表于 2016-1-9 20:10

本帖最后由 shasow 于 2016-1-9 20:21 编辑

程序已用ap加载，为什么输入db命令提示：
Command: APPLOAD db重置块内对象属性.lsp successfully loaded.
Command:
"bad character read (octal): 0"

烦请提点下，还有就是这个程序支不支持嵌套块？？能支持嵌套块才能完美解决我的问题啊!!!

shasow · 发表于 2016-1-9 21:42

我知道什么问题了，原来保存后的lsp文件名中不能有中文！
奇怪的是其他一些lsp文件，文件名可以随便命令的，为什么这个不行？？

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

[源码] 重置选定块内对象的图层、颜色、线宽属性（更新）

评分

本帖被以下淘专辑推荐:

相关帖子

本帖子中包含更多资源