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

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

本帖最后由 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)))
)

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

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

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

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

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

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

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

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

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

自贡黄明儒 发表于 2015-5-12 10:50 static/image/common/back.gif
不断输送Y or N是 不是很累

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

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

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

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

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

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

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

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

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

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



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

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

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

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

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

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

本帖最后由 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:10

我知道什么问题了,原来保存后的lsp文件名中不能有中文!
奇怪的是其他一些lsp文件,文件名可以随便命令的,为什么这个不行??
页: [1] 2
查看完整版本: 重置选定块内对象的图层、颜色、线宽属性(更新)