非常健壮的lisp
我希望能在这里找到一些帮助。我被委以重任，要吃得饱饱的。我需要一个lisp例程，将给我一个网格线和泡泡与麻木。很简单吧。
1.lisp启动时，最好询问它是单个实例还是多个实例。
2、如果是多个，则需要自动递增。
3、可以从最后输入的数字开始。
我发现了一个带有前缀但没有后缀的自动增量。但我不确定如何添加网格线和气泡。
（定义C:INN（/ch gap hg init initstr ip p1 p2 pref tb wd）
（setq bef（getstring“\n\t输入前缀或按Enter键，不输入：”）
（setq initstr（getstring“\n输入初始数字或按Enter键设置默认值：”）
（if（eq“”initstr）（setq initstr“0001”））
（setq pref“”）
（setq init（atoi initstr））
（if（等式“0”（substr initstr 1 1））
（程序
（while（eq“0”（setq ch（substr initstr 1 1）））
（setq pref（strcat pref ch））
（setq initstr（substr initstr 2ЮЮ）Ю）
（while（setq ip（getpoint“\n\t指定文本插入点（回车停止）：”）
; entmake文本
（恩特梅克）
（列表
'（0.“文本”）
“（100.“AcDbEntity”）
'（100.“AcDbText”）
（cons 1（strcat bef pref（itoa init））；一串
（cons 7“标准”）；风格
（cons 8“0”）；层
（cons 62 256）；颜色
（cons 10 ip）；插入点
（cons 11 ip）；对齐点
（cons 40（getvar“dimtxt”）；文字高度-随西装变化
（cons 41 1.0）；文本宽度
（cons 50 0.0）；1.5708-垂直，0.0-水平
（cons 51 0.0）；斜角
'(71 . 0);对齐
'(72 . 1);对齐
'(73 . 2);对齐
)
)
（setq tb（文本框（entget（entlast）））
（setq间隙（/（getvar“dimtxt”）4）
p1（汽车tb）
p2（cadr tb）
hg（abs（-cadr p1）（cadr p2）））
wd（abs（-（汽车p1）（汽车p2）））
p1（列表（-car ip）（/wd 2）间隙）（（cadr ip）（/hg 2）间隙））
p2（列表（+（汽车ip）（/wd 2）间隙）（+（cadr ip）（/hg 2）间隙））
)
; entmake框架
（恩特梅克）
（列表'（0。“LWPOLYLINE”）
“（100.“AcDbEntity”）
'（100.“AcDbPolyline”）
'(90 . 4);顶点数
'(70 . 1);关闭标志
（cons 8“0”）；层
（cons 62 2）；颜色（256-ByLayer）
（cons 10 p1）
（列表10（车辆p2）（cadr p1））
（cons 10 p2）
（列表10（车辆p1）（cadr p2））
（cons 43 0.0）；多段线宽度
)
)
（setq init（1+init））
)
（prin1）
)
（提示“\n键入INN以执行…”）
（普林斯）
提前感谢 欢迎来到论坛。
如果发布带有所需网格线和编号的DWG，可能会出现这种情况。 张贴。我希望有帮助
我写的一个非常古老的Lisp程序-可能有一些用处
; .: Nozzle & Equipment Tags :.
;
; .: by Lee McDonnell :.
(defun c:tktag2 (/ *error* dwgscal tagpt tagline linent linest linend tagang cnt tcirc tagcnt tagtxt tcirccent)
(princ "\nInitialising...")
(defun *error*(msg)
(if oldVars
(mapcar 'setvar varLst oldVars))
(if (eq msg "")
(princ "\n<< Function Complete >>")
(princ (strcat "Error: " (strcase msg))))
(princ))
(setq varLst (list "CMDECHO" "OSMODE" "CLAYER" "DIMSCALE")
oldVars (mapcar 'getvar varLst))
(setvar "cmdecho" 0)
(if (not (tblsearch "LAYER" "TAGLINE"))
(command "-layer" "m" "TAGLINE" "c" "5" "TAGLINE" ""))
(if (not (tblsearch "LAYER" "TEXT"))
(command "-layer" "m" "TEXT" "c" "2" "TEXT" ""))
(initget 7)
(if (setq dwgscal (getreal "\nType Drawing Scale: 1:"))
(progn
(setvar "clayer" "TAGLINE")
(while
(/= (setq tagpt (getpoint "\nSelect First Tag Point: ")) nil)
(prompt "\nSpecify Other Tag Points: ")
(command "_line" tagpt)
(while (> (getvar 'CmdActive) 0) (command pause))
(setq tagline (entlast)
linent(entget tagline)
linest(cdr (assoc 10 linent))
linend(cdr (assoc 11 linent))
tagang(angle linest linend)
cnt 1
tcirc (* dwgscal 4.2))
(initget 7)
(if (setq tagcnt (getint "\nSpecify Number of Tags: "))
(progn
(while (and (<= cnt tagcnt)
(/= (setq tagtxt
(getstring (strcat "\nType Text for Tag ["
(rtos cnt 2 0)
"]: ")))
""))
(setq tagtxt (strcase tagtxt))
(setvar "clayer" "TEXT")
(setq tcirccent (polar linend tagang (* (- (* cnt 2) 1) tcirc)))
(setvar "osmode" 0)
(command "_circle" tcirccent tcirc)
(entmake
(list '(0 . "TEXT")
'(8 . "TEXT")
(cons 10 tcirccent)
(cons 40 (* dwgscal 2.5))
(cons 1 tagtxt)
'(50 . 0.0)
'(7 . "STANDARD")
'(71 . 0)
'(72 . 1)
'(73 . 2)
(cons 11 tcirccent)))
(setq cnt (1+ cnt)
tagtxt "")))))))
(*error* "")
(princ))
假设块最初在图形中。 我不知道你是怎么在池塘那边请人吃午饭的，但我最好弄清楚。
李，我试过了，几乎是定制的。我想我会使用这个精确的门和窗代码，尝试把promt改成那样。我们可以让它从存储位置加载dwg模板吗？这样，如果他们重新开始，我就不必预先加载积木，否则他们会被错误地清除掉。
至于网格泡沫。是否可以选择有/没有网格线。我们可以把气泡模糊因子设置得稍微不同一点吗？
我将发布我的网格气泡lisp，这样你可以看到我们一直在做什么。
Grdbub01.txt 嗨，吉姆，
很高兴它对你有用
我可以使用LISP从filepath块位置获取块的源代码-如果您喜欢的话？
至于网格线-这应该不是问题~我希望不要在LISP中包含太多的“选项”，因为它会增加“使用”时间，但如果需要，我可以根据需要合并这些选项。
你想要偏移量吗？如果是这样，您希望对该区块及其编号做些什么？ 好的，当我在这里被鞭打的时候。
如果我们将其用于门牌，我们可以使其增量可以是数字或字母吗？
举个例子。我的房间面积是E234，有4个门。现在用lisp，我可以说前缀起始数字，然后没有后缀。当然，A行不通，因为它不是整数。
所以我会得到结果；
DE234A
DE234B
DE234C
DE234D 试穿这个尺码：
(defun c:tagger (/ *error* vLst oVars ans pTxt sTxt cnt iPt drTag bubTag drTagLst bubTagLst)
(defun *error* (msg)
(if oVars
(mapcar 'setvar vLst oVars))
(if (eq "" msg)
(princ "\n<< Function Complete >>")
(princ (strcat "Error: " (strcase msg))))
(princ))
(setq vLst (list "OSMODE" "CLAYER" "ATTREQ" "BLIPMODE")
oVars (mapcar 'getvar vLst))
(mapcar 'makelay '("A-DOOR-IDEN" "S-GRID-IDEN") '("5" "4"))
(if (and (tblsearch "BLOCK" "Tagdoor1") (tblsearch "BLOCK" "Grdbub01"))
(progn
(if (not TG:oans) (setq TG:oans "Door"))
(initget "Door Bubble")
(setq ans (getkword (strcat "\nSpecify Tag Type <" TG:oans ">: ")))
(if (not ans) (setq ans TG:oans) (setq TG:oans ans))
(if (and (setq pTxt (getstring t "\nSpecify Prefix Text <Enter for no Prefix>:"))
(not (initget 5))
(setq sNum (getint "\nSpecify Starting Number: ")
sTxt (getstring t "\nSpecify Suffix Text <Enter for no Suffix>:")))
(progn
(setq cnt 0)
(mapcar 'setvar vLst (list 0 "0" 0 0))
(while (setq iPt (getpoint "\nSelect Point for Symbol > "))
(cond ((= ans "Door")
(setvar "clayer" "A-DOOR-IDEN")
(command "-insert" "Tagdoor1" iPt "" "" "")
(setq drTag (entnext (entlast)))
(while (/= "SEQEND" (cdadr (setq drTagLst (entget drTag))))
(if (= "DR1NUM" (cdr (assoc 2 drTagLst)))
(entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt))
(assoc 1 drTagLst) drTagLst)))
(setq drTag (entnext drTag)))
(command "_regenall"))
((= ans "Bubble")
(setvar "clayer" "S-GRID-IDEN")
(command "-insert" "Grdbub01" iPt "" "" "")
(setq bubTag (entnext (entlast)))
(while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag))))
(if (= "GRIDNUM" (cdr (assoc 2 bubTagLst)))
(entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt))
(assoc 1 bubTagLst) bubTagLst)))
(setq bubTag (entnext bubTag)))
(command "_regenall")))
(setq cnt (1+ cnt))))))
(princ "\n<!> One or More Blocks not Found <!>"))
(*error* "")
(princ))
(defun makelay (x y)
(if (not (tblsearch "LAYER" x))
(command "-layer" "M" x "C" y x "")))
对于门标签，输入的数字将保持不变，并在后缀文本中输入一个字符作为“开始字符”。 线路选项是完美的。
我想我会尝试将其指向模板文件，而不是块。除非两个块都加载，否则它似乎不喜欢它。 我可以将其指向块文件路径，或者将文件路径留空，供您填写
页:
[1]
2