[原创]：改块内图元特性的小程序

John

在我的工作中，同一设备在不同图中表示时需要用不同的颜色及线型表示，因此编了这个程序。因为不会vlisp和dcl，所以做成纯lisp程序。
本程序用于指定已插入图中的图块内部图元的颜色、图层、线型，对于块内有嵌套块的情形一并改掉，因此如果希望嵌套块不变的情形本程序不适用，需要的可以自己修改BKMD_PR函数加个条件判断。
请批评指正
在选颜色时用acad_colordlg 调用了对话框，但图层和线型没有现成函数调用对话框，我本来想用(command  "layer")但无法显示对话框，如何在command函数里面显示命令的对话框？
本程序参考了tc405003 :)
[PHP](defun C:BKMD ()
  (prompt "**********更改块内图元********** \n")
  (setq cmd (getvar "CMDECHO"))
  (setvar "cmdecho" 0)
  (prompt "\n选择需要改动的块: ")
  (setq ent_blk (ssget '((0 . "INSERT"))))
  (setq count (sslength ent_blk))
  (setq index 0)
  (initget 1 "1 2 3 ")
  (setq setkey (getkword "\nCOLOR 1/LAYER 2/LINETYPE 3/ <>   "))
  (cond
    ((= setkey "1")
      (setq attr (acad_colordlg 7)
            dxfcode 62
      )
    )
    ((= setkey "2")
      (setq attr (getstring "改到何层? ")
            dxfcode 8
      )
    )
    ((= setkey "3")
      (setq attr (getstring "改为何种线型? ")
            dxfcode 6
      )
    )
    (t   nil)
  )
  (repeat count
    (setq eg1 (entget (ssname ent_blk index)))
    (setq en1 (ssname ent_blk index))
    (redraw en1 3)
    (setq en1 nil)
    (setq nam (cdr (assoc 2 eg1)))
    (setq en2 (cdr (assoc -2 (tblsearch "block" nam))))
    (BKMD_PR dxfcode attr en2 nam)
    (setq index (+ index 1))
  )
  (setvar "CMDECHO" cmd)
  (princ)
)
(defun BKMD_PR (dxfcode attr en2 nam)
  (setq cnt 0)
  (while en2
    (setq cnt (1+ cnt)
          eg2 (entget en2)
          en2 (entnext (cdr (assoc -1 eg2)))
    )
    (grtext -2 (strcat nam " block entity # " (itoa cnt)))
    (if (= (cdr (assoc 0 eg2)) "insert")
      (progn
        (setq nm2 (cdr (assoc 2 eg2))
              en3 (cdr (assoc -2 (tblsearch "block" nm2)))
        )
        (BKMD_PR dxfcode attr en3 nm2)
      )
      (progn
        (if (assoc dxfcode eg2)
          (setq eg2 (subst
                      (cons dxfcode attr)
                      (assoc dxfcode eg2)
                      eg2
                    )
          )
          (setq eg2 (append
                      eg2
                      (list (cons dxfcode attr))
                    )
          )
        )
        (entmod eg2)
      )
    )
  )
  (setq ss1 (ssget "x" (list (cons 2 nam)))
        cnt 0
  )
  (while (setq en1 (ssname ss1 cnt))
    (setq cnt (1+ cnt))
    (entupd en1)
  )
)
(princ)
(princ "BKMD loaded! Start command with BKMD")
[/PHP]

aeo

双击编辑不是更方便.

John

谢谢您的建议，只是觉得当块定义很复杂如图元多、有嵌套块时，或者图形交错图元不好选择时就有用了。
PS：请教，能否在command函数里面显示所调用命令的对话框？

lsjjm

最初由 John 发布
[B]... 我本来想用(command "layer")但无法显示对话框，如何在command函数里面显示命令的对话框？
[/B]

(initdia)
(command "layer")

boyhaodong

这个是不是只是用语cad上呢！也就是说用他来改变cad里面图层的颜色？

nuance

楼主能不能加深一下程序，使之可以修改多层图块中的任意子图元？
另外是不是完善一下变量表．

ljs026

大大真棒！

jinsong-liao

能提高绘图效率，顶！

lshpool

要是能改块中块就完美了

jx2008

程序很好，使用递归函数。
涉及到嵌套块内图元实体的坐标更改的情况，论坛上很少有程序设计，能否写一个这样的例程？

sjy2005

(command -style BarSt 宋体 TtH 1 0 n n n)
(command "-style" "BarSt" "宋体" TtH 1 0 "n" "n" "n")
(command "-style" "standred" "宋体" 10 1 0 "n" "n" "n")