按顺序编号并插入
你好我发现一个例程允许多次复制数字文本字符串，每次增加一个数字。
现在，我需要在按顺序插入文本的同时插入一个块。
有人能帮我吗？
这是我发现的惯例：
;======================================================================
; CopyInc2.lsp最新版本：C.法语99年9月29日
;----------------------------------------------------------------------
; 此例程允许您多次复制数字文本字符串
; 次，每次增加一个数字。如果文本有
; 字母前缀，这也将被复制。例如，如果您
; 复制文本“A102”，下一个将是“A103”，“A104”
; 等等
;
; 非常感谢J.Richardson最初的“CopyInc”例行程序
; 这一点基于此。
;======================================================================
（定义C:CopyInc（/OrigEnt OrigEntData OrigText NumText）
PrefixLen Prefix Num NewEntData NewPt Continue）
（setq copyincolderorfunc*错误*）
（setq*error*CopyIncErrorFunc）
（while（=OrigEnt nil）
（setq OrigEnt（entsel“\n选择文本：”）
)
（setq OrigEntData（cdr（entget（car OrigEnt）））
（如果（/=（cdr（assoc 0 OrigEntData））“文本”）
（原则“未选择文本”）
（程序
（setq OrigText（cdr（assoc 1 OrigEntData）））
（setq NumText（GetSuffixDigits OrigText））
（如果（=NumText“”）
（princ“该文本字符串不以数字结尾。”）
（程序
（setq PrefixLen（-（strlen OrigText）（strlen NumText）））
（if（=预桥0）
（setq前缀“”）
（setq前缀（substr OrigText 1 PrefixLen））
)
（setq Num（atoi NumText））
（setq Continue T）
（继续时
（setq Num（1+Num））
（setq NewEntData（subst（cons 1（strcat前缀（itoa Num）））
（assoc 1 OrigEntData）OrigEntData）
（initget 128）
（setq NewPt（getpoint“\n复制到（按Enter键退出）：”）
（如果（=NewPt nil）
（setq Continue nil）
（程序
（setq NewEntData（subst（cons 10 NewPt））
（assoc 10 NewEntData）NewEntData）
（entmake NewEntData）
)
)
);while循环结束
)
)
)
)
（setq*error*copyincolderorfunc）
（普林斯）
)
;----获取足够的数字---------------------------------------------------
; 此函数接受字符串参数，该参数在
; 到此为止。它只返回由这些数字组成的字符串。例如：
; （GetSuffixDigits“A102”）返回“102”
; （GetSuffixDigits“102”）返回“102”
; （GetSuffixDigits“”）返回“”
; （GetSuffixDigits“ABC”）返回“”
; （GetSuffixDigits 123）将生成错误（错误的参数类型）
;----------------------------------------------------------------------
（defun GetSuffixDigits（OrigStr/Digits-PrefixLen-Char）
（setq数字“”）
（setq PrefixLen（strlen OrigStr））
（同时（>预桥0）
（setq Char（substr OrigStr PrefixLen 1））；获取字符串的最后一个字符
（if（wcmatch Char“#”）；如果是数字。。。
（程序
（setq数字（strcat字符数字））；包含在结果str中
（setq PrefixLen（1-PrefixLen））；准备检查下一个chr
)
（setq PrefixLen 0）；第一次退出alpha
)
)
（setq数字）
)
;----错误处理----------------------------------------------------
; 下面的例程提供了我们的错误处理，以防用户
; 取消CopyInc功能。全局保存指向
; 当前错误处理程序，以便在退出时恢复。
;----------------------------------------------------------------------
（setq copyincolderorfunc nil）；全球持有旧func
（defun CopyIncErrorFunc（msg）
（如果（=消息“功能已取消”）
（普林斯）
（如果（=消息“退出/退出中止”）
（普林斯）
（princ（strcat“\n错误：“msg”）
)
)
（setq*error*copyincolderorfunc）
（普林斯）
)
;----加载后会显示如何使用的说明-------------------
（princ“\n键入“CopyInc”复制并增加文本字符串。”）
（普林斯） 再次Lisp程序（没有微笑……）
我还在等待帮助。。。
;======================================================================
; CopyInc2.lsp Last Revision: C.French 29/09/99
;----------------------------------------------------------------------
;This routine allows you to copy a numerical text string multiple
;times, incrementing the number by one each time. If the text has
;an alphabetic prefix, this will be copied too. For example if you
;copy the piece of text "A102", the next ones will be "A103", "A104"
;and so on.
;
;Many thanks to J. Richardson for the original "CopyInc" routine
;upon which this one is based.
;======================================================================
(defun C:CopyInc ( / OrigEnt OrigEntData OrigText NumText
PrefixLen Prefix Num NewEntData NewPt Continue)
(setq CopyIncOldErrorFunc *error*)
(setq *error* CopyIncErrorFunc)
(while (= OrigEnt nil)
(setq OrigEnt (entsel "\nSelect text: "))
)
(setq OrigEntData (cdr (entget (car OrigEnt))))
(if (/= (cdr (assoc 0 OrigEntData)) "TEXT")
(princ "No text selected.")
(progn
(setq OrigText (cdr (assoc 1 OrigEntData)))
(setq NumText (GetSuffixDigits OrigText))
(if (= NumText "")
(princ "That text string doesn't end with a number.")
(progn
(setq PrefixLen (- (strlen OrigText)(strlen NumText)))
(if (= PrefixLen 0)
(setq Prefix "")
(setq Prefix (substr OrigText 1 PrefixLen))
)
(setq Num (atoi NumText))
(setq Continue T)
(while Continue
(setq Num (1+ Num))
(setq NewEntData (subst (cons 1 (strcat Prefix (itoa Num)))
(assoc 1 OrigEntData) OrigEntData))
(initget 128)
(setq NewPt (getpoint "\nCopy to (press Enter to quit): "))
(if (= NewPt nil)
(setq Continue nil)
(progn
(setq NewEntData (subst (cons 10 NewPt)
(assoc 10 NewEntData) NewEntData))
(entmake NewEntData)
)
)
);end of while loop
)
)
)
)
(setq *error* CopyIncOldErrorFunc)
(princ)
)
;----GetSuffixDigits---------------------------------------------------
;This function accepts a string argument which has digits at the
;end of it. It returns a string of just those digits. For example:
; (GetSuffixDigits "A102")returns"102"
; (GetSuffixDigits "102") returns"102"
; (GetSuffixDigits "") returns""
; (GetSuffixDigits "ABC") returns""
; (GetSuffixDigits 123)will generate an error (bad argument type)
;----------------------------------------------------------------------
(defun GetSuffixDigits ( OrigStr / Digits PrefixLen Char)
(setq Digits "")
(setq PrefixLen (strlen OrigStr))
(while (> PrefixLen 0)
(setq Char (substr OrigStr PrefixLen 1)) ;get last char of string
(if (wcmatch Char "#") ;if it's a digit...
(progn
(setq Digits (strcat Char Digits)) ;include in result str
(setq PrefixLen (1- PrefixLen)) ;ready to check next chr
)
(setq PrefixLen 0) ;quit at first alpha
)
)
(setq Digits Digits)
)
;----Error Handling----------------------------------------------------
;The routine below supplies our error handling in case the user
;cancels the CopyInc function. The global holds the pointer to the
;current error handler so it can be restored on exit.
;----------------------------------------------------------------------
(setq CopyIncOldErrorFunc nil) ;global holds old func
(defun CopyIncErrorFunc (msg)
(if (= msg "Function cancelled")
(princ " ")
(if (= msg "quit / exit abort")
(princ " ")
(princ (strcat "\nError: " msg))
)
)
(setq *error* CopyIncOldErrorFunc)
(princ)
)
;----Instructions appear after loading on how to use-------------------
(princ "\nType 'CopyInc' to copy and increment a text string.")
(princ)
我希望这个能让你开始
(defun c:ibl (/ atd blk cnt ech ipt next next_data osm pref suff tag)
(setq osm (getvar "osmode"))
(setq ech (getvar "cmdecho"))
(setq atd (getvar "attdia"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setvar "attdia" 1)
(setq pref (getstring T "\nSpecify prefix or press Enter for none: "))
(setq suff (getstring T "\nSpecify suffix or press Enter for none: "))
(setq cnt (getint "\nEnter initial number: "))
(if cnt
(progn
;(setq tag (strcase (getstring "\nEnter attribute tag for numbering: ")))
(setq tag "NUM");change attribute tag "NUM" on tag name in your block which uses for increment numbering
(while (setq ipt (getpoint "\nPick insertion point of block or press Enter to Exit: "))
(command "-insert" "STA" ipt 1 1 0);<- change block name "STA" on your block name here
(setq blk (entlast))
(setq next blk)
(while (setq next (entnext next))
(setq next_data (entget next))
(if (= tag (cdr (assoc 2 next_data)))
(progn
(entmod (subst (cons 1 (strcat pref (itoa cnt) suff)) (assoc 1 next_data) next_data))
(entupd blk)
)
)
)
(setq cnt (1+ cnt))
)
)
)
(setvar "osmode" osm)
(setvar "attdia" atd)
(setvar "cmdecho" ech)
(prin1)
)
(prompt "\ntype iBL to execute ...")
(prin1)
关于这一点：
(setq pref (getstring T "\nSpecify prefix or press Enter for none: "))
~'J'~ 再次感谢fixo的快速回答。
但我想要这样的东西：
你能再帮我一次吗？ 你的意思是默认设置前缀吗？
如果是这样，请使用此代码块：
(setq pref "MyFavouritePrefix")
~'J'~ 是的，这就是我想要的。
再次非常感谢 大家好，
我真的很喜欢这个lisp代码，并且一直在我们的通风部分使用它，我只是想知道你们中的一个聪明人是否可以帮我稍微调整一下。
选择前缀后，我希望代码在图形中搜索所有名为“ID”的块，检查所选前缀“for ensample A”，并找到用于示例A12”的最后一个标记值，并提示用户使用下一个值“A13”或输入自己的编号
我目前必须手动执行此操作
这就是我目前所拥有的
（if（ssget“x”'（（2。“ID”））
（程序
（setq ent（ssname（ssget“x”'（（2。“ID”））0））
（while（not（eq'“REV”（cdr（assoc 2）（setq attlst（entget ent k）'）））））
（setq ent（entnext ent））
)
（if（=1（setq rev#）（+1（ascii（cdr（assoc 1 attlst Ϟ）Ϟ）））））
（setq版本#65）
)
我的块是“ID”，属性标记名是“REV”
看看这是否适合你
（defun getlastattrib（blockname标记名前缀/atstr lng num osset revlist）（或（vl load com））（setq lng（1+（strlen前缀））num nil）（if（setq osset（ssget“X”（list（cons 0“INSERT”）（cons 2 blockname）（cons 66 1））（progn（foreach blkobj（mapcar'vlax ename->vla object（vl remove if'listp（mapcar'cadr（ssnamex osset））））（foreach att（vlax invoke blkobj'getattributes）（if（eq（vlax get att'tagstring）标记名）（setq atstr（vlax get att'textstring）））（if（wcmatch atstr（strcat prefix“*”）（setq revlist（cons（substr atstr lng）revlist））））（setq num（car（vl sort revlist（function）（lambda（a b）（>（atof a）（atof b 107;）k）num）；在主程序内如下调用此函数：（setq lastnum（getlastattrib“ID”“REV”“A”）； 太棒了！
工作正常
比我想象的好多了真的很喜欢窗口消息
再次感谢
约翰 不客气
干杯
页:
[1]
2