自动编号？
我需要一种方法来创建数字序列中的文本字符串。我正在使用平均得分为42分的终端机架。术语架垂直编号为1-42。然而，这个数字非常。。。i、 e.术语框架可以编号为1-42、43-84，以此类推。。。有42个点需要分配数字，只要列表可以垂直或水平填充，它将为我工作。我附上了一个图片什么是一个热门术语机架看起来像。。。这个数字序列是从上到下递减的，但我通常是从上到下递减的。这是我写的一个旧的，可以修改为“自动编号”。
;; ============ Num.lsp ===============
;;
;;FUNCTION:
;;Will sequentially place numerical
;;text upon mouse click, with optional
;;prefix and suffix.
;;
;;SYNTAX: num
;;
;;AUTHOR:
;;Copyright (c) 2009, Lee McDonnell
;;(Contact Lee Mac, CADTutor.net)
;;
;;PLATFORMS:
;;No Restrictions,
;;only tested in ACAD 2004.
;;
;;VERSION:
;;1.0~05.04.2009
;;
;; ====================================
(defun c:num(/ vlst ovar dVars tmpVars pt)
(setq vlst '("OSMODE" "CLAYER")
ovar (mapcar 'getvar vlst))
(setvar "OSMODE" 0)
(or (tblsearch "LAYER" "NumText")
(vla-put-color
(vla-add
(vla-get-layers
(vla-get-ActiveDocument
(vlax-get-acad-object))) "NumText") acYellow))
(setq dVars '(sNum inNum Pref Suff))
(mapcar '(lambda (x y) (or (boundp x) (set x y))) dVars '(1 1 "" ""))
(setq tmpVars (list (getreal (strcat "\nSpecify Starting Number <" (rtos sNum 2 2) ">: "))
(getreal (strcat "\nSpecify Increment <" (rtos inNum 2 2) ">: "))
(getstring (strcat "\nSpecify Prefix <" (if (eq "" Pref) "-None-" Pref) ">: "))
(getstring (strcat "\nSpecify Suffix <" (if (eq "" Suff) "-None-" Suff) ">: "))))
(mapcar '(lambda (x y) (or (or (not x) (eq "" x)) (set y x))) tmpVars dVars)
(while (setq pt (getpoint "\nClick for Text... "))
(Make_Text pt (strcat Pref (rtos sNum 2 2) Suff))
(setq sNum (+ sNum inNum)))
(mapcar 'setvar vlst ovar)
(princ))
(defun Make_Text(txt_pt txt_val)
(entmake (list '(0 . "TEXT")
'(8 . "NumText")
(cons 10 txt_pt)
(cons 40 (max 2.5 (getvar "TEXTSIZE")))
(cons 1 txt_val)
'(50 . 0.0)
(cons 7 (getvar "TEXTSTYLE"))
'(71 . 0)
'(72 . 1)
'(73 . 2)
(cons 11 txt_pt))))
作为快速修改-没有时间：
;; ============ Num.lsp ===============
;;
;;FUNCTION:
;;Will sequentially place numerical
;;text upon mouse click, with optional
;;prefix and suffix.
;;
;;SYNTAX: num
;;
;;AUTHOR:
;;Copyright (c) 2009, Lee McDonnell
;;(Contact Lee Mac, CADTutor.net)
;;
;;PLATFORMS:
;;No Restrictions,
;;only tested in ACAD 2010.
;;
;;VERSION:
;;1.0~05.04.2009
;;2.0~15.06.2009
;;
;; ====================================
(defun c:num(/ dVars tmpVars pt ang sNum*)
(setq dVars '(sNum eNum inNum Spc Dir))
(mapcar '(lambda (x y) (or (boundp x) (set x y))) dVars '(1 10 1 1 "X"))
(setq tmpVars (list (getreal (strcat "\nSpecify Starting Number <" (rtos sNum 2 2) ">: "))
(getreal (strcat "\nSpecify Ending Number <" (rtos eNum 2 2) ">: "))
(getreal (strcat "\nSpecify Increment <" (rtos inNum 2 2) ">: "))
(getreal (strcat "\nSpecify Spacing <" (rtos Spc 2 2) ">: "))))
(initget "X Y")
(setq tmpVars
(append tmpVars (list (getkword (strcat "\nSpecify Direction <" Dir ">: ")))))
(mapcar '(lambda (x y) (or (not x) (set y x))) tmpVars dVars)
(if (eq Dir "X") (setq ang 0) (setq ang (/ pi 2)))
(if (setq pt (getpoint "\nSpecify Start Point: ") i 0 sNum* sNum)
(while (<= sNum* eNum)
(Make_Text (polar pt ang (* i Spc)) (rtos sNum* 2 2))
(setq sNum* (+ sNum* inNum) i (1+ i))))
(princ))
(defun Make_Text(pt val)
(entmake
(list
(cons 0 "TEXT")
(cons 8 (getvar "CLAYER"))
(cons 10 pt)
(cons 62 2)
(cons 40 (getvar "TEXTSIZE"))
(cons 1 val)
(cons 50 0.0)
(cons 7 (getvar "TEXTSTYLE"))
(cons 71 0)
(cons 72 1)
(cons 73 2)
(cons 11 pt))))
太好了，谢谢！这就成功了
我还有一个小问题，对正在中间和左边，我只需要它在左边。据我所知，lisp中没有这一行，我可以将其添加到其中吗？ 我发现这个工具可以改变m和dtext的对齐方式，但对我来说太多了，我只需要在自动计数器工具中添加一行代码来设置左边的对齐方式。
(Make_Text (polar pt ang (* i Spc)) (rtos sNum* 2 2))
没关系我自己想出来的
这段代码给出了位置的证明代码
; ***JUSTIFY.LSP***
;
; Changes the justification of text to:-
; Left, Center, Right, Aligned, Middle, Fit,
; Bottom left, center or right,
; Middle left, center or right, OR
; Top left, center of right
;
(defun C:JUSTIFY (/ a a1 a2 a3 a4 t m n n1 p1
p q j j0 n2 j1 j2 q1 index dummy)
(setvar "cmdecho" 0)
(graphscr)
(prompt "\n *Select text to change justification...")(terpri)
(setq t (ssget))
(if $just
(setq dummy nil)
(setq $just "C")
)
(prompt "\n *Enter appropriate letter or select from pull down menu...")
(initget "L C R A M F BL BC BR ML MC MR TL TC TR")
(setq j1 (getkword (strcat
"\n *L/C/R/M/A/F/BL/BC/BR/ML/MC/MR/TL/TC/TR: <" $just "> ")))
(if (= j1 "")
(setq j1 $just)
(setq $just j1)
)
(setq m (sslength t)
index 0)
(repeat m
(setq a (entget (ssname t index))
p (cdr (assoc 0 a)))
(if (= p "TEXT")
(progn
(setq j (assoc 72 a)
j2 (assoc 73 a)
p (assoc 10 a)
q (assoc 11 a)
j0 (cdr j))
(if (or (= j1 "L")(= j1 "C")(= j1 "R")(= j1 "M")
(= j1 "BL")(= j1 "BC")(= j1 "BR")
(= j1 "ML")(= j1 "MC")(= j1 "MR")
(= j1 "TL")(= j1 "TC")(= j1 "TR"))
(if (= j0 0)
(progn
(setq p1 (cdr p)
q1 (cons (car q) p1)
n1 (subst q1 q a))
)
(progn
(setq q1 (cdr q)
p1 (cons (car p) q1)
n1 (subst p1 p a))
)
)
)
(if (or (= j1 "A")(= j1 "F"))
(progn
(prompt "\n ")
(prin1 (+ index 1))
(setq a1 (getpoint "\nEnter first alignment point...")
a2 (getpoint "\nEnter second alignment point...")
a3 (cons (car p) a1)
a4 (cons (car q) a2)
n1 (subst a3 p a)
n2 (subst a4 q n1))
)
)
(cond ((= j1 "L")(setq n (subst '(72 . 0) j n1))
(setq n (subst '(73 . 0) j2 n)))
((= j1 "C")(setq n (subst '(72 . 1) j n1))
(setq n (subst '(73 . 0) j2 n)))
((= j1 "R")(setq n (subst '(72 . 2) j n1))
(setq n (subst '(73 . 0) j2 n)))
((= j1 "A")(setq n (subst '(72 . 3) j n2))
(setq n (subst '(73 . 0) j2 n)))
((= j1 "M")(setq n (subst '(72 . 4) j n1))
(setq n (subst '(73 . 0) j2 n)))
((= j1 "F")(setq n (subst '(72 . 5) j n2))
(setq n (subst '(73 . 0) j2 n)))
((= j1 "BL") (setq n (subst '(72 . 0) j n1))
(setq n (subst '(73 . 1) j2 n)))
((= j1 "BC") (setq n (subst '(72 . 1) j n1))
(setq n (subst '(73 . 1) j2 n)))
((= j1 "BR") (setq n (subst '(72 . 2) j n1))
(setq n (subst '(73 . 1) j2 n)))
((= j1 "ML") (setq n (subst '(72 . 0) j n1))
(setq n (subst '(73 . 2) j2 n)))
((= j1 "MC") (setq n (subst '(72 . 1) j n1))
(setq n (subst '(73 . 2) j2 n)))
((= j1 "MR") (setq n (subst '(72 . 2) j n1))
(setq n (subst '(73 . 2) j2 n)))
((= j1 "TL") (setq n (subst '(72 . 0) j n1))
(setq n (subst '(73 . 3) j2 n)))
((= j1 "TC") (setq n (subst '(72 . 1) j n1))
(setq n (subst '(73 . 3) j2 n)))
((= j1 "TR") (setq n (subst '(72 . 2) j n1))
(setq n (subst '(73 . 3) j2 n)))
)
(entmod n)
)
)
(setq index (+ index 1))
)
(prin1)
(princ " Changed ") ; Print total lines changed
(princ index)
(princ " text lines.")
(terpri)
(princ)
)
所以我在自动计数工具中查找类似的内容，发现了这个
(cond ((= j1 "L")(setq n (subst '(72 . 0) j n1))
(setq n (subst '(73 . 0) j2 n)))
我把这个改成了
(cons 7 (getvar "TEXTSTYLE"))
'(71 . 0)
'(72 . 1)
'(73 . 2)
我在左下角找到了理由
我希望这条信息能帮助其他人，为大家干杯。 很好，Jammie。我希望在适当的时候更新这个程序。 已阅读
（defun c:num（/tmpVars pt ang sNum*）（setq dVars“（sNum eNum inNum Spc Pref Suff tsize Dir））（mapcar“（lambda（x y）（or（boundp x）（set x y）））dVars“（1 10 1 1”“”“2.5“x”）（setq tmpVars（list）（getreal（strcat”\n指定起始编号：）（getreal（strcat”\n指定结束编号：）（getreal（strcat”\n指定终止编号：）（getreal（strcat”\n指定增量：））（getreal（strcat“\n指定间距：”）（if（=（setq tmppref（getstring（strcat”\n指定前缀：”）“”）Pref tmppref）（if（=（setq tmpsuff（getstring（strcat“\n指定后缀：”））“”）Suff tmpsuff）（if（not（setq tmptsize（getreal（strcat“\n指定文本大小：”）））tsize tmptsize））（initget“X Y”）（setq tmpVars（追加tmpVars（list（getkword（strcat“\n指定方向：”）））（mapcar’（lambda（X Y）（或（非X）（set Y X）））tmpVars dVars）（if（eq Dir“X”）（setq ang 0）（setq ang（/pi 2））（if（setq pt（getpoint“\n指定起点：”）i 0 sNum*sNum）（而（ 这很有效。。。不过有一个问题。。。如果希望前缀和后缀为空，我会键入什么？ 另一个问题。。。。我该如何得到垂直Y形式的数字，从1到任意值，从上到下，而不是像现在这样从下到上？
页:
[1]
2