[编程申请]：自动录入序号。

eachy · 发表于 2002-9-16 00:38:24

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

正在画图，要编排很多序号，A1、A2、....；B1、B2....等等，有可能以后会删除或增加中间的编号，这时整个序列中要改很多文字。
编程要求：
1 输入时可以加前缀前缀为大写字母，后面是数字文字点用鼠标定位
2 另外一个命令，在删掉中间编号后，程序能够自动重排此序列文字。

谢谢。

eachy · 发表于 2002-9-16 01:05:02

如图所示的序号。

xdq931220 · 发表于 2002-9-16 10:18:10

我有一个

e2002 · 发表于 2002-9-16 12:03:33

1,这个问题很简单
2. 这个可能比较麻烦,要搜索选择集,排序,可能还有数字增长或减少的步长调整,,,,

aeo · 发表于 2002-9-16 20:23:53

你的意思是不是这样
比如你已经写了 A1 A2 A3 A4
再任意地方写假定A2,原来的A2 A3 A4自动改为A3 A4 A5

无痕 · 发表于 2002-9-17 00:02:45

和插入，修改轴号的原理差不多

XDSoft · 发表于 2002-9-17 03:04:28

程序写好了：

1、
;|
命令：XDTB_SymbolBz
功能：递增标注序号
说明：1、所在图层：公共文字－PUB_TEXT
               2、未标前缀类：序号起始于1。
         标过的前缀：起始图中最大号＋1。
      3、可以在标注中“任意”变换前缀，序号自动判断相应前缀已标的最大号。
|;

2、
;|
命令：XDTB_SymbolErase
功能：序号删除
说明：擦除后，同类前缀重排序号。
|;

;|
命令：XDTB_SymbolBz
功能：标注序号
说明：1、所在图层：公共文字－PUB_TEXT
2、可以在标注中任意变换前缀，序号自动判断相应前缀已标的最大号。
|;
(defun c:XDTB_SymbolBz (/ $XDTB_Symbol_getNo tf prefix height)
(defun $XDTB_Symbol_getNo (prefix / ss e no maxNo)
(setq ss (ssget "x" '((-3 ("XDTB_SYM_XH"))))
maxNo 0
)
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq info (xdrx_getxdata e "XDTB_SYM_XH"))
(if (= (strcase prefix) (car info))
(progn
(setq no (cadr info))
(if (> no maxNo)
(setq maxNo no)
)
)
)
)
(+ 1 maxNo)
)
(setq tf t)
(if (not $XDTB_Symbol_Prefix)
(setq $XDTB_Symbol_Prefix "A")
)
(if (not $XDTB_Symbol_TxtH)
(setq $XDTB_Symbol_TxtH "350")
)
(setq $XDTB_Symbol_No ($XDTB_Symbol_getNo $XDTB_Symbol_Prefix))
(xdrx_begin "公共文字")
(while (and
tf
(progn
(prompt (strcat "\n{字高:" $XDTB_Symbol_TxtH " / 前缀:"
$XDTB_Symbol_Prefix " / 起始序号:"
(itoa $XDTB_Symbol_No) "}"
)
)
t
)
(progn
(initget 128 "1 2")
(setq tf (getpoint "\n拾取序号插入点[修改前缀(1)/字高(2)]<退出>:"))
(setq dxy tf)
(cond
((= tf "1")
(if (/= "" (setq prefix (getstring (strcat "\n请输入前缀符号<" $XDTB_Symbol_Prefix
">:"
)
)
)
)
(progn
(setq $XDTB_Symbol_Prefix (strcase prefix))
(setq $XDTB_Symbol_No ($XDTB_Symbol_getNo $XDTB_Symbol_Prefix))
)
t
)
)
((= tf "2")
(if (/= "" (setq height (getstring (strcat "\n请输入字高<" $XDTB_Symbol_TxtH
">:"
)
)
)
)
(setq $XDTB_Symbol_TxtH height)
t
)
)
((and
(listp tf)
(car tf)
)
(command "._text" tf $XDTB_Symbol_TxtH 0.0 (strcat $XDTB_Symbol_Prefix
(itoa $XDTB_Symbol_No)
)
)
(xdrx_setXdata (entlast) "XDTB_SYM_XH" $XDTB_Symbol_Prefix
$XDTB_Symbol_No
)
(setq $XDTB_Symbol_No (1+ $XDTB_Symbol_No))
)
(t
)
)
)
)
)
(xdrx_end)
(princ)
)
;|
命令：XDTB_SymbolErase
功能：序号删除
说明：擦除后，同类前缀重排序号。
|;
(defun c:XDTB_SymbolErase (/ $XDTB_Symbol_Sort el e ss eData prefix noL old new no)
(defun $XDTB_Symbol_Sort (el / n prefix ss e info old noL new el1 i)
(foreach n el
(setq el1 nil)
(setq prefix (car n))
(setq ss (ssget "x" '((-3 ("XDTB_SYM_XH"))))
)
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq info (xdrx_getxdata e "XDTB_SYM_XH"))
(if (= (strcase prefix) (car info))
(progn
(if (setq old (assoc prefix el1))
(progn
(setq noL (cdr old)
noL (apply
'xdrx_rlistsort1
(cons (list (cadr info) e) noL)
)
new (cons prefix noL)
el1 (subst
new
old
el1
)
)
)
(progn
(setq el1 (cons (list prefix (list (cadr info) e)) el1))
)
)
)
)
)
(prompt (strcat "\n正在对序号簇 "" prefix "" 进行重排..."))
(setq i 1)
(foreach n (cdar el1)
(setq ee (cadr n))
(xdrx_setenttodb ee)
(xdrx_modent 1 (strcat prefix (itoa i)))
(xdrx_setXdata ee "XDTB_SYM_XH" prefix i)
(setq i (1+ i))
)
(prompt "...完毕！")
)
(princ)
)
(prompt "\n请选取要擦除的序号[全选-(All)]<退出>:")
(if (setq ss (ssget '((-3 ("XDTB_SYM_XH")))))
(progn
(xdrx_begin)
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq eData (xdrx_getXdata e "XDTB_SYM_XH")
prefix (car eData)
no (cadr eData)
)
(if (setq old (assoc prefix el))
(progn
(setq noL (cdr old)
noL (apply
'xdrx_realsort1
(cons no noL)
)
new (cons prefix noL)
el (subst
new
old
el
)
)
)
(progn
(setq el (cons (list prefix no) el))
)
)
(entdel e)
)
($XDTB_Symbol_Sort el)
(xdrx_end)
)
)
(princ)
)
[/font]

;| 
   命令：XDTB_SymbolBz 
   功能：标注序号 
   说明：1、所在图层：公共文字－PUB_TEXT 
        2、可以在标注中任意变换前缀，序号自动判断相应前缀已标的最大号。 
|; 
(defun c:XDTB_SymbolBz (/ $XDTB_Symbol_getNo tf prefix height) 
  (defun $XDTB_Symbol_getNo (prefix / ss e no maxNo) 
    (setq ss (ssget "x" '((-3 ("XDTB_SYM_XH")))) 
          maxNo 0 
    ) 
    (xdrx_setsstodb ss 0) 
    (while (setq e (xdrx_getentdata 0)) 
      (setq info (xdrx_getxdata e "XDTB_SYM_XH")) 
      (if (= (strcase prefix) (car info)) 
        (progn 
          (setq no (cadr info)) 
          (if (> no maxNo) 
            (setq maxNo no) 
          ) 
        ) 
      ) 
    ) 
    (+ 1 maxNo) 
  ) 
  (setq tf t) 
  (if (not $XDTB_Symbol_Prefix) 
    (setq $XDTB_Symbol_Prefix "A") 
  ) 
  (if (not $XDTB_Symbol_TxtH) 
    (setq $XDTB_Symbol_TxtH "350") 
  ) 
  (setq $XDTB_Symbol_No ($XDTB_Symbol_getNo $XDTB_Symbol_Prefix)) 
  (xdrx_begin "公共文字") 
  (while (and 
           tf 
           (progn 
             (prompt (strcat "\n{字高:" $XDTB_Symbol_TxtH " / 前缀:" 
                             $XDTB_Symbol_Prefix " / 起始序号:" 
                             (itoa $XDTB_Symbol_No) "}" 
                     ) 
             ) 
             t 
           ) 
           (progn 
             (initget 128 "1 2") 
             (setq tf (getpoint "\n拾取序号插入点[修改前缀(1)/字高(2)]<退出>:")) 
             (setq dxy tf) 
             (cond 
               ((= tf "1") 
                 (if (/= "" (setq prefix (getstring (strcat "\n请输入前缀符号<" $XDTB_Symbol_Prefix 
                                                            ">:" 
                                                    ) 
                                         ) 
                            ) 
                     ) 
                   (progn 
                     (setq $XDTB_Symbol_Prefix (strcase prefix)) 
                     (setq $XDTB_Symbol_No ($XDTB_Symbol_getNo $XDTB_Symbol_Prefix)) 
                   ) 
                   t 
                 ) 
               ) 
               ((= tf "2") 
                 (if (/= "" (setq height (getstring (strcat "\n请输入字高<" $XDTB_Symbol_TxtH 
                                                            ">:" 
                                                    ) 
                                         ) 
                            ) 
                     ) 
                   (setq $XDTB_Symbol_TxtH height) 
                   t 
                 ) 
               ) 
               ((and 
                  (listp tf) 
                  (car tf) 
                ) 
                 (command "._text" tf $XDTB_Symbol_TxtH 0.0 (strcat $XDTB_Symbol_Prefix 
                                                                    (itoa $XDTB_Symbol_No) 
                                                            ) 
                 ) 
                 (xdrx_setXdata (entlast) "XDTB_SYM_XH" $XDTB_Symbol_Prefix 
                                $XDTB_Symbol_No 
                 ) 
                 (setq $XDTB_Symbol_No (1+ $XDTB_Symbol_No)) 
               ) 
               (t 
               ) 
             ) 
           ) 
         ) 
  ) 
  (xdrx_end) 
  (princ) 
) 
;| 
   命令：XDTB_SymbolErase 
   功能：序号删除 
   说明：擦除后，同类前缀重排序号。 
|; 
(defun c:XDTB_SymbolErase (/ $XDTB_Symbol_Sort el e ss eData prefix noL old new no) 
  (defun $XDTB_Symbol_Sort (el / n prefix ss e info old noL new el1 i) 
    (foreach n el 
      (setq el1 nil) 
      (setq prefix (car n)) 
      (setq ss (ssget "x" '((-3 ("XDTB_SYM_XH")))) 
      ) 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (setq info (xdrx_getxdata e "XDTB_SYM_XH")) 
        (if (= (strcase prefix) (car info)) 
          (progn 
            (if (setq old (assoc prefix el1)) 
              (progn 
                (setq noL (cdr old) 
                      noL (apply 
                            'xdrx_rlistsort1 
                            (cons (list (cadr info) e) noL) 
                          ) 
                      new (cons prefix noL) 
                      el1 (subst 
                            new 
                            old 
                            el1 
                          ) 
                ) 
              ) 
              (progn 
                (setq el1 (cons (list prefix (list (cadr info) e)) el1)) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (prompt (strcat "\n正在对序号簇 "" prefix "" 进行重排...")) 
      (setq i 1) 
      (foreach n (cdar el1) 
        (setq ee (cadr n)) 
        (xdrx_setenttodb ee) 
        (xdrx_modent 1 (strcat prefix (itoa i))) 
        (xdrx_setXdata ee "XDTB_SYM_XH" prefix i) 
        (setq i (1+ i)) 
      ) 
      (prompt "...完毕！") 
    ) 
    (princ) 
  ) 
  (prompt "\n请选取要擦除的序号[全选-(All)]<退出>:") 
  (if (setq ss (ssget '((-3 ("XDTB_SYM_XH"))))) 
    (progn 
      (xdrx_begin) 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (setq eData (xdrx_getXdata e "XDTB_SYM_XH") 
              prefix (car eData) 
              no (cadr eData) 
        ) 
        (if (setq old (assoc prefix el)) 
          (progn 
            (setq noL (cdr old) 
                  noL (apply 
                        'xdrx_realsort1 
                        (cons no noL) 
                      ) 
                  new (cons prefix noL) 
                  el (subst 
                       new 
                       old 
                       el 
                     ) 
            ) 
          ) 
          (progn 
            (setq el (cons (list prefix no) el)) 
          ) 
        ) 
        (entdel e) 
      ) 
      ($XDTB_Symbol_Sort el) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
) 
 
 
 
 
[/font]

点下面附件下载，拷贝到工具箱目录，加载后，用相应命令执行。

XDSoft · 发表于 2002-9-17 12:02:21

序号擦除写好了，请重新下载上面的附件。

zemehua · 发表于 2002-10-14 17:26:18

太好了，非常及时，thankvery much!

拉契 · 发表于 2014-10-12 15:35:43

xdrx_setsstodb 这个函数怎么找不到！！！

Lisphk · 发表于 2014-10-12 15:43:43

拉契发表于 2014-10-12 15:35
xdrx_setsstodb 这个函数怎么找不到！！！

要加载 xdrx_api

iLisp · 发表于 2014-10-12 19:32:48

没想到12年前就有这个

账号		自动登录	找回密码
密码			立即注册

[编程申请]：自动录入序号。

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

序号擦除写好了，请重新下载上面的附件。

点评

浏览过的版块