选定矩形的自动编号
你好，我在这个论坛上看到了很多lisp自动编号的例子，这对我来说有点复杂。
但我只需要一个简单的lisp，它会自动将数字放在矩形的中心。在我选择了矩形之后。我想要。
例如，如果我选择10个矩形。我需要按顺序将rect编号为1到10。
顺便问一下，这也适用于六边形吗？
有人能帮忙吗？
谢谢
肯贝 你看过李的这套（递增编号套件）吗？
http://www.lee-mac.com/numinc.html 您好，备注，，
我看过李的帖子。
但这不是我想要的。。
我没有选择图形中已经存在的矩形（不是块）的选项。
给我贴标签。
谢谢
当做
肯贝 试试这个代码可能会有帮助
(defun C:INR (/ *error* cpt dxf elist en ent emake_txt inc info midpt pfx pts
sfx sset start tht)
;; increment numbering of rectangles
(defun *error*(msg)
(command "_undo"
"_end")
(if (and msg
(not (wcmatch (strcase msg)
"*BREAK*,*CANCEL*,*QUIT*,")))
(princ (strcat
"\nError: " msg)))
)
;;helpers:
(defun dxf (key
alist)
(cdr (assoc key alist))
)
(defun
midpt (p1 p2)
(mapcar '(lambda(x y)(* (+ x y) 0.5))p1
p2)
)
(defun emake_txt(pt txt hgt)
;;middle center;;
(entmake (list '(0 .
"TEXT")
'(100 . "AcDbEntity")
'(67 .
0)
'(8 . "0")
'(100 .
"AcDbText")
(cons 10(list (- (car pt) (* hgt (strlen txt)
0.47))(- (cadr pt)(/ hgt 2.))(caddr pt)))
(cons 40
hgt)
(cons 1 txt)
'(50 . 0)
'(41
. 1)
'(51 . 0)
'(7 . "Standard"); change on your
text style here
'(71 . 0)
'(72 .
1)
(cons 11 pt)
'(100 .
"AcDbText")
'(73 . 2)))
)
;; main part ;;
(if
(and
(setq pfx (getstring "\n Prefix:
")
sfx (getstring
"\n Suffix: ")
start (getint
"\n Starting number: ")
step
(getint "\n Increment step: ")
tht
(getreal "\n Text heigh: ")))
(progn
(command "_undo" "_be")
(prompt "\n Select rectangles in the
right order:")
(while
(setq sset
(ssget "_+.:S:L"
(list (cons 0
"lwpolyline")
(cons 90
4)
(cons 70 1))))
(setq en (ssname sset
0))
(setq pts (vl-remove-if 'not (mapcar '(lambda(x)(if (= 10 (car
x))(cdr x)))(entget en)))
cpt (trans (midpt (car pts)(caddr
pts)) 1 0))
(emake_txtcpt (strcat pfx (itoa start) sfx)
tht)
(setq start (+ start step))
)
)
)
(*error* nil)
(princ)
) ;_ end of defun
(prompt
"\n\t---\tType INR to execute\t---")
(prin1)
嗨，菲索，
我在运行程序时遇到这个错误（错误：坏DXF组：nil）。
我错过了什么吗。
此外，我希望能够在矩形上进行栅栏选择，而不是1乘1。
谢谢
当做
肯贝 然后通读代码，找到一行
程序失败了，否则我需要绘图来查看
问题不在于此 这行应该是这样的
'(7 . "Standard"); change on yourtext style here
我相信当你复制粘贴代码的时候。这条线不经意间就这样结束了
'(7 . "Standard"); change on your
text style here
随便。下面是一个更新的短代码[演示代码]
(defun c:NRI ( /*IntGet1 sn ss i e sum verts ptList p )
;; pBe 25May2013 ;;;
(defun *IntGet1 (fn msg def)
(setq type_ (vl-symbol-name (type def)))
(initget 6)
(setq val ((eval fn) (strcat msg " <" (vl-some '(lambda (x)
(if (eq (Car x) type_)(eval (cadr x))))
(list '("REAL" (rtos def 2 2))' ("INT" (itoa def)) '("STR" def))) ">: ")))
(if (or (null val)
(eq "" val))
def val))
(foreach Var '(("TxtHt" 1.0) ("sn" 1) ("pref" "X"))
(if (setq dflt (eval (read (car var))))
dflt (set (read (car var)) (cadr var))
))
(setq TxtHt (*intget1 'getreal "\nEnter text height" TxtHt)
sn (*intget1 'getint "\nEnter Start Number" sn)
pref (strcase (*intget1 'getstring "\nEnter Start Number" pref)))
(if (setq i -1 ss (ssget '((0 . "LWPOLYLINE"))))
(repeat (sslength ss)
(setq e (ssname ss (setq i (1+ i)))
sum '(0 0)
verts (cdr (assoc 90 (entget e))))
(setq ptList
(mapcar 'cdr
(vl-remove-if-not
'(lambda (x) (= (car x) 10))
(entget e))))
(foreach x ptList (setq sum (mapcar '+ x sum)))
(setq p (mapcar '/ sum (list vertsverts)))
(entmakex
(list
(cons 0 "TEXT")
(cons 10 p)
(cons 11 p)
(cons 40 TxtHt)
'(50 . 0.0)
'(72 . 4)
'(73 . 3)
(cons 1 (Strcat pref " " (itoa sn))
)
)
)
(setq sn (1+ sn))
)
)
(princ)
)
HTH公司 谢谢Patrick，你的演示代码比我的短得多，
但是没有看到他的样图，任何事情都只是猜测，
可能是重复的验证，或者矩形没有闭合
或者其他一些东西，谁知道呢？
干杯
你说得对。最近，根据最近的请求/请求ER，我们只做了这些 嗨，菲索，
我真诚地向你道歉。Patrick是对的，我在记事本上粘贴了带有文字扭曲的程序，没有注意到错误。
现在没有错误。
但是我仍然需要一个接一个地选择矩形，我在图形中有大约80到100个矩形要选择。
希望不要问太多，如果你可以修改它，这样我可以做一个栅栏选择。
谢谢
当做
肯贝
页:
[1]
2