[求助]哪位高手帮我编下这个小程序吧！先谢了！

我爱lisp

我想对块的编号重新排序，相信大家可能都会碰到这样个问题： 比如说，当图块很多的时候，需要插入一个号，则需要将原来的图块号依次的更改，一个一个的改很麻烦。我想通用编个带循环的程序，依次对后面的号加1或加几，这样一下就全改了。对于不是块属性很容易实现。我对块的数据结构不是太清楚，飞哥给我写了几行，但小弟实在鲁钝的很，不知道该如何下手，麻烦大家有空帮我写写。先谢了。 这是获取块属性的程序，我就不知道该如何加替换某个属性的语句进去。 （当然我写不出来，这好像是我买陈老师书上的） (Defun C:SBlockA ()
(SetQ bn (Car (EntSel "\n指定带属性的块: ")))
(If (Assoc 66 (EntGet bn))
(Progn (SetQ bn (EntNext bn)
bl (EntGet bn)
)
(While (= "ATTRIB" (Cdr (Assoc 0 bl)))
(Alert (StrCat "属性名: " (Cdr (Assoc 2 bl))
"\n属性值: " (Cdr (Assoc 1 bl))
)
)
(SetQ bl (EntGet (SetQ bn (EntNext bn))))
)
)
(Alert "没有属性...")
)
)

王咣生

用下面的函数修改块的属性: ;;;***************************************************************************;;;
;;; MODULE: vlex-ChangeAttributes (lst) ;;;
;;; DESCRIPTION: ;;;
;;; ARGS: ;;;
;;; EXAMPLE: (vlex-ChangeAttributes (list blk (cons "tag" "new-value"))) ;;;
;;;***************************************************************************;;;
;;; Arguments:
;;; A list containing one atom and one or more dotted pairs.
;;; The atom is the entity name of the block to change.
;;; The dotted pairs consist of the attribute tag and the new value for that attribute.
;;;
;;; Notes:
;;; Modifies the specified attribute in the specified block reference
;;;***************************************************************************;;; (vl-load-com)
(defun vlex-ChangeAttributes (lst / blk itm atts)
(setq blk (vlax-Ename->vla-Object (car lst))
lst (cdr lst)
)
(if (= (vla-Get-HasAttributes blk) :vlax-true)
(progn
(setq atts (vlax-SafeArray->list
(vlax-Variant-Value (vla-GetAttributes blk))
)
); setq
(foreach item lst
(mapcar
'(lambda (x)
(if (= (strcase (car item)) (strcase (vla-Get-TagString x)))
(vla-Put-TextString x (cdr item))
); endif
)
atts
); mapcar
); foreach
(vla-Update blk)
)
); endif
) 参数为一个表: (块实体名 (属性标记 . 新的属性值))

我爱lisp

非常感谢了，以前好像很少见你发言的哈，以后请多指教。

redearth

佩服班主!

我爱lisp

王咣生大虾： 我用你的核心程序写了一个，先给大家看看，我觉得还挺好用的，下步我让他自动号码顺延。过几天空了再说吧。 (Defun C:SBA ()
(vl-load-com)
(SetQ oldnumber (getstring "\n: 指定修改的图块号:"))
(SetQ addnumber (getstring "\n: 增加值:"))
(SetQ bn (Car (EntSel "\n指定带属性的块: ")))
(while bn
(progn
(SetQ newnumber (+ (atoi oldnumber) (atoi addnumber)))
(SetQ newstring (itoa newnumber))
(vlex-ChangeAttributes (list bn (cons "编号" newstring)))
;(alert newstring)
(setq oldnumber (itoa newnumber))
(SetQ bn (Car (EntSel "\n指定带属性的块: ")))
)

)
(alert "finished!!")
)

tianliangle

我爱lisp 你挺厉害的呀！！！等你的下篇哦。