文本到属性，然后是cre
又是你好我加入了李·麦克（txt2att）和塔瓦（qb）的两个很棒的剧本
但我知道这是可以优化的。。。。
我这样做的目的是抓取现有的文本（一个接一个），并将其转换为属性，然后转换为块。所以我问你们几个问题：
1） 创建属性时，我希望用户提示输入块名，其余的保持原样
2） 在引入块名后，它要求文本一个接一个地将每个块转换为具有相同名称但不同值的块，而文本allready具有相同的名称。这可能吗？？？
如果我不清楚，请说出来。
thx高级
(defun c:txt2att ( / el i ss st selectionset insertionpoint number Blockname ) (vl-load-com)
(if (setq ss (ssget "_:L" '((0 . "TEXT"))))
(repeat (setq i (sslength ss))
(setq el (entget (ssname ss (setq i (1- i))))
st (vl-string-translate " " "_" (cdr (assoc 1 el)))
)
(if
(entmakex
(append '((0 . "ATTDEF"))
(vl-remove-if '(lambda ( pair ) (member (car pair) '(0 100 73))) el)
(list
(cons 700)
(cons 74 (cdr (assoc 73 el)))
(cons2 st)
(cons3 st)
)
)
)
(entdel (cdr (assoc -1 el)))
)
)
)
(if (and (setq selectionset (ssget "_:L"))
(setq insertionpoint (getpoint "n Specify insertion point :"))
)
(progn
(setq number 1
Blockname (strcat "MyBlock" (itoa number))
)
(while (tblsearch "BLOCK" Blockname)
(setq Blockname
(strcat "MyBlock" (itoa (setq number (1+ number))))
)
)
(command "_.-Block" Blockname insertionpoint selectionset "")
(command "_.-insert" Blockname insertionpoint "" "" "")
)
(princ)
)
(princ)
) 或者如果更简单，另一个脚本：
1） 提示用户选择多个文本
2） 提示输入现有块名称
3） 删除文本并在文本位置插入所选块
4） 将块的值替换为上一个文本内容。。。。
我的梦是不是太响了？？？
当做 至少有人能告诉我我疯了哈！哈哈
我的目标是用大量文本替换这些块，以便我可以计算它们。
问题是块名称重复，但有许多不同之处，因为在这种情况下，有不同类型的配电盘。
对不起，如果这太糟糕了
当做 如果你想的话，你也可以数数文本，只需做一个选择集，然后长度就是数量，你也可以做得更聪明一些，选择所有文本排序列表，然后遍历列表并比较下一个文本值，当它改变时，写出总数。
;This is a bit rough but a starting point
(setq ss1 (ssget(list (cons 0 "TEXT,MTEXT"))));pick text
(setq len (sslength ss1))
; the len is the number of text
让我们知道这是否是可行的方法 您好，Bigal thx获得答案
嗯，就是这样。我有10个图纸，其中充满了代表不同电气面板的文本片段。
前任。
201202203204，属于配电盘QPP1
201202402403404，属于配电盘QPP2
等等
正如你们想象的，这是一个有点棘手的计数，因为其中一些是平等的，但从不同的配电盘。。。
我想做的是使用一个预制块，名称是配电盘的名称（QPP1、QPP2、QS、QE等），并替换其中的文本：
1） 脚本启动并请求块名（在本例中为QPP1、QPP2、QS、QE等）
2） 用户选择现有文本（当然属于特定的配电盘）
3） 脚本读取此文本上存在的数值
4） 然后删除预先拾取的文本
5） 插入选定的块
6） 将块值更改为数值预读
p、 用户是我
p、 s.2对我来说，这是在使用另一个脚本或qselect来计数并逐个选择面板值之后
p、 然后留在那里，如果我改变了什么，我可以再次数数，而不是每次我想数数的时候都这么做。。。
p、 s.4我的lisp知识几乎为0
对不起，我不清楚。如果是这样，请说
当做 嘿
我刚刚发现了这个线程：Lisp例程在点位置插入块
我正试图改变10/10后的脚本（由艾伦·J·汤普森制作），以满足我的需要。
我理解，将行（ssget“_：L”'（（0。“POINT”））更改为（ssget“_：L”'（（0。“TEXT”））它要求文本，但脚本没有获得文本坐标，并离开脚本。。。你能帮助我吗？
顺便说一下，这个脚本已经：
1） 脚本启动并请求块名（在本例中为QPP1、QPP2、QS、QE等）
2） 用户选择现有文本（当然属于特定的配电盘）
3)....
4） 然后删除预先拾取的文本
5） 插入选定的块
6)....
但仍然忽略了：
3） 脚本读取此文本上存在的数值
6） 将块值更改为数值预读
thx高级 你好
我在这里也问了一个解决方案，Moshe-a给了我一个，我把l8ter换成了中间插入。
谢谢你们 在我存储的代码中，测试很少，看看这个是否有效
(defun C:axbt(/ *error* acsp adoc align attobj block_coll block_def bname bref
en hgt msg name names orig pmt sset style tag txtobj txtval val)
(vl-load-com)
(defun *error* (msg)
(if adoc (vla-endundomarkadoc))
(if
(and msg
(not
(member
msg
'("console break"
"Function cancelled"
"quit / exit abort"
""
)
)
)
)
(princ (strcat "\nError: " msg))
)
(setvar "nomutt" 0)
(princ)
)
(or adoc
(setq adoc (vla-get-activedocument
(vlax-get-acad-object))))
(or acsp
(setq acsp (if (= (getvar "CVPORT") 1)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc)
)
)
)
(setq block_coll (vla-get-blocks adoc))
(vla-endundomark adoc)
(vla-startundomark adoc)
(while (tblsearch "BLOCK"
(setq bname (getstring T "\nEnter block name: ")))
(progn
(alert "Block already exist, input another name")
(setq msg "")
(vlax-for obj(setq names (vlax-map-collection block_coll 'vla-get-name))
(setq name (vla-get-name obj))
(if (not (wcmatch name "`**"))
(setq msg (strcat msg (vla-get-name obj) "\n"))))
(alert (strcat "Check existing blocks:\n" msg))))
(setvar "nomutt" 0)
(prompt
"\nSelect a single text by single pick to get properies from\n")
(setvar "nomutt" 1)
(while (not
(setq sset (ssget "_:S:L" (list (cons 0 "text")))))
(alert (strcat "Select text again")))
(setq txtobj (vlax-ename->vla-object (ssname sset 0)))
(setvar "aflags" 4)
(setvar "attreq" 0)
(setvar "attdia" 1)
(setvar "nomutt" 0)
(prompt "\nCreating block with ActiveX method\n")
(setq orig (vlax-get txtobj 'insertionpoint)
pmt"Panel type" ; prompt
tag"PANEL_TYPE" ;tag
val(vlax-get txtobj 'textstring) ;default value
)
(setq hgt (vlax-get txtobj 'height)
style (vlax-get txtobj 'stylename)
align (vlax-get txtobj 'alignment))
;; add block definition first
(setq block_def (vla-add block_coll (vlax-3d-point orig) bname))
;; change properties of the block definition
(vla-put-blockscaling block_def 1)
(vla-put-blockscaling block_def 1)
(vla-put-units block_def 1) ; possible enums: acInsertUnitsInches, acInsertUnitsUnitless, acInsertUnitsMillimeters, acInsertUnitsMeters, etc
;; add attribute
(setq attobj (vlax-invoke
block_def
'addattribute
hgt
acattributemodepreset
pmt
orig
tag
val))
;; change properties of the attribute
(vlax-put attobj 'alignment align)
(vlax-put attobj 'stylename style)
(vla-put-layer attobj "0")
(vlax-put attobj 'color 0)
(princ "\n")
(if (not (tblsearch "BLOCK" bname))
(progn
(alert "Error oncreating blocks")
(exit)
(princ))
(progn
(setvar "nomutt" 0)
(prompt "\n\nSelect all texts to convert to blocks\n")
(setvar "nomutt" 1)
(if (setq tset (ssget "_:L" (list (cons 0 "text"))))
(while (setq en (ssname tset 0))
(setq txtobj (vlax-ename->vla-object en))
(setq xlist (cons txtobj xlist))
(setq orig (vlax-get txtobj 'insertionpoint))
(setq txtval (vla-get-textstring txtobj))
(setq orig (vlax-get txtobj 'insertionpoint))
(setq bref (vlax-invoke acsp 'insertblock orig bname 1 1 1 0))
(foreach attobj(vlax-invoke bref 'getattributes)
(if (eq tag (vla-get-tagstring attobj))
(vla-put-textstring attobj txtval)
(vla-update attobj))
)
(ssdel en tset)
(entdel en)
)
)
(setvar "nomutt" 0)
)
)
(vl-catch-all-apply
'(lambda () (vlax-release-object block_def)))
(*error* nil)
(princ)
)
(princ "\n\t\t Start command with: AXBT\n")
(prin1)
页:
[1]