用chan重新定义块
我想重新定义一个块。旧块没有单独定义标记名，因此我正在重新定义标记名；问题是我丢失了输入的值。是否有lisp例程可以保存和刷新这些输入的值。有数百个图纸与这个旧块，所以重新打字一切都是过度。到目前为止，我所做的是：
（1） 创建了新块，所有标记分别命名为
（2） 使用与旧块相同的名称保存块
（3） 插入新块并同意重新定义旧块
（4） 执行“attsync”以加快所有新属性标记名称的速度。
（5） *********这就是我丢失之前所有值的地方******
有人知道lisp会先存储这些值，然后在“attsync”完成后重新恢复它们吗。提示从旧块到新块保持不变，因此这可能是可以在存储过程中使用的共同点。
谢谢大家。。。喜欢这个网站 不确定这是否有帮助？
(defun c:BlkRep (/ *error* nlk doc spc blk i ss uflag ent nObj aLst att tag)
(vl-load-com)
(setq nblk "C:\\...dwg") ;; Filepath of New Block to Insert
(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(while
(progn
(setq blk (getstring t "\nSpecify Block Name to Replace: "))
(cond ((eq "" blk) nil)
((not (setq i -1 ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blk)))))
(princ "\n** Block not Found in Drawing **")))))
(if ss
(progn
(setq uflag (not (vla-StartUndomark doc)))
(while (setq ent (ssname ss (setq i (1+ i))))
(setq nObj
(vla-Insertblock spc
(vla-get-InsertionPoint
(setq Obj (vlax-ename->vla-object ent))) nblk
(vla-get-Xscalefactor obj)
(vla-get-yScalefactor obj)
(vla-get-zscalefactor obj)
(vla-get-Rotation obj)))
(setq aLst
(mapcar
(function
(lambda (x)
(cons (strcase (vla-get-TagString x)) (vla-get-TextString x))))
(vlax-invoke Obj 'GetAttributes)))
(foreach att (vlax-invoke nObj 'GetAttributes)
(if (setq tag (assoc (strcase (vla-get-TagString att)) aLst))
(vla-put-TextString att (cdr tag))))
(entdel ent))
(setq uflag (vla-EndUndoMark doc))))
(princ))
在顶部用双反斜杠指定新块的文件路径。
麦克，它比鼻涕还滑！！
哈哈，这是一种说法。。。 谢谢李的快速回复。。好吧，这对我来说还不起作用。有两件事正在发生。首先，我得到一个错误，说块的定义重复。。。忽略，其次，如果我将传入的块更改为新的块名，它似乎不会出错，但该块会消失或在完成后从页面中删除。
谢谢 好啊不确定是否有人仍在阅读这篇文章或需要解决此问题的方法，但在进一步研究后，我似乎需要使用VBA搜索PromptString，并将其引用到标记字符串名称的更改：因此，我向所有VBA编写者发出挑战，要求他们提供帮助，因为我只使用lisp，而不是VBA。
属性标记示例（1）：
标签：-
提示：REV 1绘制人
违约：
属性标记示例（2）：
标签：-
提示：版本1日期
违约：
示例（1）和示例（2）是在称为“title\u block”的同一块中显示的标记
VBA需要搜索提示：REV 1 DATE，并将与该提示相关联的标记名从-更改为REV-1-DATE
VBA需要搜索提示：REV 1 Draw BY，并将与该提示关联的标记名从-更改为REV-1-Draw-BY
谢谢大家
我有一本是很多月前写的，刚刚换了
提示列表
当然，没有你的坏积木，我无法测试它
试试看
(defun C:CTP(/)
(defun change-tags-by-prompts (/ adoc att bname ent find obj prompts)
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(setq prompts '("REV 1 DRAWN BY"
"REV 1 DATE")
)
(setq ent (car (entsel "\n *** Select block to change tags: ")))
(if ent
(progn
(setq obj (vlax-ename->vla-object ent))
(if (eq :vlax-false (vla-get-isdynamicblock obj))
(setq bname (vla-get-name obj))
(setq bname (vla-get-effectivename obj))
)
(vlax-for att (vla-item (vla-get-blocks adoc) bname)
(if (eq (vla-get-objectname att) "AcDbAttributeDefinition")
(if (setq find (member (vla-get-promptstring att) prompts))
(vla-put-tagstring att (strcase (car find)))
)
)
)
(setvar "cmdecho" 0)
(command "._attsync" "_N" bname)
(setvar "cmdecho" 1)
(vlax-release-object obj)
)
)
(princ)
)
(change-tags-by-prompts)
(princ)
)
(vl-load-com)
(princ "\n *** Type CTP to execute **")
(prin1)
~'J'~ 谢谢你的回复。。。。。它几乎起作用了。
我附上了标题栏文件以供参考。当我运行CTP时，它会更改其他两个标记的标记名，而不是指定的标记名，并且所有输入的值都正好移动了2个空格。
我会尝试修改你给我的，因为这是一个很好的开始！！！！谢谢如果我有什么想法，我会发布。如果你有机会，可以试着在我附上的文件上运行它吗。思想？？？
非常感谢。
标题栏。图纸
这个版本怎么样
(defun change-tags-by-prompts (/ acsp adoc att atts att_info blockname
block_info bname cur_lst ent find ipt layer
new_block obj prompts rot xscale yscale zscale)
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
acsp (vla-get-block
(vla-get-activelayout adoc)
)
)
(setq ent (car (entsel "\n *** Select block to change tags tags: ")))
(if ent
(progn
(setq obj (vlax-ename->vla-object ent))
(if (eq :vlax-false (vla-get-isdynamicblock obj))
(setq bname (vla-get-name obj))
(setq bname (vla-get-effectivename obj))
)
(vlax-for att(vla-item (vla-get-blocks adoc) bname)
(if (eq (vla-get-objectname att) "AcDbAttributeDefinition")
(progn (setq prompts (cons (vla-get-promptstring att) prompts))
(vla-put-tagstring att (strcase (vla-get-promptstring att)))
)
)
)
(setq prompts (reverse prompts))
(vlax-release-object obj)
(vlax-for layout (vla-get-layouts adoc)
(vlax-for blk(vla-get-block layout)
(if (eq (vla-get-objectname blk) "AcDbBlockReference")
(progn
(if (eq :vlax-false (vla-get-isdynamicblock blk))
(setq blockname (vla-get-name blk))
(setq blockname (vla-get-effectivename blk))
)
(if (eq bname blockname)
(progn
(setq block_info nil)
(setq ipt (vla-get-insertionpoint blk)
layer(vla-get-layer blk)
rot (vla-get-rotation blk)
xscale (vla-get-xscalefactor blk)
yscale (vla-get-yscalefactor blk)
zscale (vla-get-zscalefactor blk)
)
(foreach att(vlax-invoke blk 'Getattributes)
(setq att_info (cons (car prompts)
(vla-get-textstring att)
)
)
(setq prompts (cdr prompts))
(setq block_info (cons att_info block_info))
)
(setq block_info (reverse block_info))
(setq new_block (vla-insertblock acsp ipt bname xscale yscale zscale rot))
(vla-put-layer new_block layer)
(setq atts (vlax-invoke new_block 'Getattributes))
(foreach attatts
(if (setq find (assoc (vla-get-tagstring att) block_info))
(vla-put-textstring att (cdr find)))
)
)
)
)
)
)
)
)
)
(princ)
)
(defun C:CTP(/)
(change-tags-by-prompts)
(princ)
)
(vl-load-com)
(princ "\n *** Type CTP to execute **")
(prin1)
~'J'~ 太棒了！！！！！非常感谢菲索。还有一件事要补充。。。创建的标记名与提示完全相同，并且包含标记名不喜欢的属性空格。有没有办法指定标签名。。。。。。。因此，带有“REV 1 DATE”提示的标签现在变成了“REV_1_DATE”，甚至更具体地说是“R1DATE”
干杯
页:
[1]
2