选定矩形的自动编号

KENBE · 发表于 2022-7-6 06:32:43

你好，
我在这个论坛上看到了很多lisp自动编号的例子，这对我来说有点复杂。
但我只需要一个简单的lisp，它会自动将数字放在矩形的中心。在我选择了矩形之后。我想要。
例如，如果我选择10个矩形。我需要按顺序将rect编号为1到10。
顺便问一下，这也适用于六边形吗？
有人能帮忙吗？
谢谢
肯贝

ReMark · 发表于 2022-7-6 06:41:45

你看过李的这套（递增编号套件）吗？

http://www.lee-mac.com/numinc.html

KENBE · 发表于 2022-7-6 06:43:14

您好，备注，，
我看过李的帖子。
但这不是我想要的。。
我没有选择图形中已经存在的矩形（不是块）的选项。
给我贴标签。
谢谢
当做
肯贝

fixo · 发表于 2022-7-6 06:49:16

试试这个代码可能会有帮助

copy


(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_txt  cpt (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)

KENBE · 发表于 2022-7-6 06:57:41

嗨，菲索，
我在运行程序时遇到这个错误（错误：坏DXF组：nil）。
我错过了什么吗。
此外，我希望能够在矩形上进行栅栏选择，而不是1乘1。
谢谢
当做
肯贝

fixo · 发表于 2022-7-6 06:59:45

然后通读代码，找到一行
程序失败了，否则我需要绘图来查看
问题不在于此

pBe · 发表于 2022-7-6 07:05:15

这行应该是这样的

copy

   '(7 . "Standard")[b]; change on your  text style here[/b]

我相信当你复制粘贴代码的时候。这条线不经意间就这样结束了

copy

   '(7 . "Standard"); change on your 
text style here

随便。下面是一个更新的短代码[演示代码]

copy

(defun c:NRI ( /  *IntGet1 sn ss i e sum verts ptList p )
;;        pBe 25May2013        ;;;
[color="blue"](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)[/color]
     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 verts  verts)))
        (entmakex
          (list
            (cons 0 "TEXT")
            (cons 10 p)
            (cons 11 p)
            (cons 40 TxtHt)
            '(50 . 0.0)
            '(72 . 4)
            '(73 . 3)
            (cons 1[color="blue"][b] (Strcat pref " " (itoa sn))[/b][/color]
                  )
            )
          )
                 (setq sn (1+ sn))
        )
 )
(princ)
)