编了个CAD绘图统一规定，依此制定了个新的dwt文件。整个画图方式有了很大、巨大乃至庞大的变化，以前的很多东西都不好用了。因此，有了“bh-新编号”的升级版。还没有好好试用，现在已知的缺陷是不能属性块、数字在一个程序里混用。有时间再调吧！

;针对一整行或一整列名为"件号-单个" "件号-横连" "件号-竖连"的动态块自动编号
;模式：横排、竖排（允许编号属性块上下或左右偏移10mm）；升序(从下到上递增、从左到右递增)、降序（从上到下递增、从右到左递增）
;标号格式为单纯的整数，或为带前缀的整数(例；1，a-1，2-1，3-4-1，即"-"之后必须为整数)
;程序按编号数量多少的默认排列方式为横排还是竖排,数量相等时默认为竖排（此处数量统计时只统计动态块的数量，不考虑具体可见的"属性"的数量）
;当有多个数量相等的横排或竖排,横排取y值最大的,竖排取x值最小的
;自动记录上一次手动输入的起始值（方便图面上的零件号与对应的材料表中的编号同时进行自动编号）

(defun c:bh(/ x_offset y_offset ss n sn en_list en en_data pt x_list y_list x_temp y_temp
     x_len y_len xx_len yy_len hs rf prefix suffix )
    (setq csv (getvar "cannoscalevalue"))
    (setq x_offset (/ 10.0 csv));x向偏移量,用组码10来排序，文本长度及对齐方式不同可能造成偏移量较大
    (setq y_offset (/ 10.0 csv));y向偏移量
    (setq ss (ssget '((0 . "insert"))))

    ;标号文本图元排序
    (setq n -1)
    (setq sn (sslength ss))
    (setq en_list '())
    (repeat sn
 (setq en (ssname ss (setq n (1+ n)))) 
 (if (member (vla-get-effectivename (vlax-ename->vla-object en)) '("件号-单个" "件号-横连" "件号-竖连"));(cdr (assoc 2 (entget (entnext en))))取得动态块的原始名称
     (progn
  (setq en_data (entget en))
  (setq pt (cdr (assoc 10 en_data)))
  (if (not (zerop (cdr (assoc 50 en_data)))) ;转变为当前坐标系
      (setq pt (trans pt en 0))
  )

  (setq en_list (cons (list (car pt)
       (cadr pt)
       (cdr (assoc 5 en_data))
        )
        en_list
         )
  )
     )
 )
    )
    (setq x_list '())
    (setq y_list '())
    (setq xx_len 0)
    (setq yy_len 0)
    (foreach n en_list
 (setq x_temp '())
 (setq y_temp '())
 (setq x_len 0)
 (setq y_len 0)
 (setq x (car n))
 (setq y (cadr n))
 (foreach m en_list
     (if (< (abs (- (car m) x)) x_offset)
  (progn
      (setq x_temp (cons m x_temp))
      (setq x_len (1+ x_len))
  )
     )
     (if (< (abs (- (cadr m) y)) y_offset)
  (progn
      (setq y_temp (cons m y_temp))
      (setq y_len (1+ y_len))
  )
  
     )
 )
 (if (not x_list)
     (setq x_list x_temp xx_len x_len xx x)
     (if (or (> x_len xx_len) (and (= x_len xx_len) (< x xx)))  
  (setq x_list x_temp xx_len x_len xx x)
     )  
 )
 (if (not y_list)
     (setq y_list y_temp yy_len y_len yy y)
     (if (or (> y_len yy_len) (and (= y_len yy_len) (> y yy)))  
  (setq y_list y_temp yy_len y_len yy y)
     )    
 ) 
    ) 
    (setq x_list (vl-sort x_list '(lambda (x y) (< (cadr x) (cadr y)))))
    (setq y_list (vl-sort y_list '(lambda (x y) (< (car x) (car y)))))
    (setq x_ss (ssadd))
    (foreach n x_list (setq x_ss (ssadd (handent (caddr n)) x_ss)))
    (setq y_ss (ssadd))
    (foreach n y_list (setq y_ss (ssadd (handent (caddr n)) y_ss)))

    ;标号模式确认
    (if (> yy_len xx_len) 
 (setq hs "横排")
 (setq hs "竖排")
    )
    (setq rf "升序")
    (setq prefix (vlax-ldata-get "bilt-bh-dict" "bilt-bh-prefix"));前缀
    (if (not prefix) (setq prefix ""))
    (setq suffix (vlax-ldata-get "bilt-bh-dict" "bilt-bh-suffix"));后缀
    (if (not suffix) (setq suffix "1"))   
   
    (setq sn t)
    (while sn　
 (princ (strcat "\n当前设置:　" hs " " rf " " "起始值<" (strcat prefix suffix) ">"))
 (if (= hs "竖排")
     (sssetfirst nil x_ss)
     (sssetfirst nil y_ss)
 )
 (setq bh (strcat prefix suffix))
 (setq txt (getstring
       (strcat
    "\n请输入新的起始值或[横排(h)/竖排(s)/升序(r)/降序(f)]<"
    bh
    ">:"
       )
   )
 )
 (if (= txt "");输入新的起始值或输入为空则退出
     (setq sn nil)
     (if (or (= txt "H") (= txt "h"))
  (setq hs "横排")
  (if (or (= txt "S") (= txt "s"))
      (setq hs "竖排")
      (if (or (= txt "R") (= txt "r"))
   (setq rf "升序")
   (if (or (= txt "F") (= txt "f"))
       (setq rf "降序")
       (if (wcmatch txt "~*[~0-9]*")
    (progn
        (setq prefix "")
        (setq suffix txt)
        (setq sn nil)
    )
    (if (and (setq n (vl-string-position
           (ascii "-")
           txt
           nil
           t
       )
      )
      (wcmatch (substr txt (+ n 2)) "~*[~0-9]*")
        )
        (progn
           (setq prefix (substr txt 1 (1+ n)))
           (setq suffix (substr txt (+ n 2)))
           (setq sn nil)
        )
        (princ "\n需要起始值或选项关键字。")
    )
       )
   )
      )
  )
     )
 )
    )
    (sssetfirst nil nil)
    (setq suffix (1- (atoi suffix)))
    (setq bh_suffix (1+ suffix));编号初始值
    (if (= hs "横排")
 (setq en_list y_list)
 (setq en_list x_list)
    )
    (if (= rf "降序") (setq en_list (reverse en_list)))

    ;文本图元标号值修改
    (foreach n en_list
 (setq en (handent (caddr n)))
 (setq num_list (list (strcat prefix (itoa (setq suffix (1+ suffix))))))
 (if (/= (vla-get-effectivename (vlax-ename->vla-object en)) "件号-单个")
     (progn
  (setq num_data (entget (setq en_att (entnext en))))
  (setq x (cadr (assoc 10 num_data)))
  (setq y (caddr (assoc 10 num_data)))
  (setq num_data (entget (setq en_att (entnext en_att))))
  (setq xx (cadr (assoc 10 num_data)))
  (setq yy (caddr (assoc 10 num_data)))
  (if (or (and (or (> x xx) (> y yy)) (= rf "降序")) (and (or (< x xx) (< y yy)) (= rf "升序")))
      (setq rev t)
      (setq rev nil)
  )
  (while (and (= "ATTRIB" (cdr (assoc 0 num_data))) (/= 1 (cdr (assoc 60 num_data))))
      (setq num_list (cons (strcat prefix (itoa (setq suffix (1+ suffix)))) num_list))
      (setq num_data (entget (setq en_att (entnext en_att))))
  )
  (if rev
      (setq num_list (reverse num_list))
  )
     )
 
 )
 (mapcar 'vla-put-textstring (vlax-invoke (vlax-ename->vla-object en) 'GetAttributes) num_list)
    )
    (vlax-ldata-put "bilt-bh-dict" "bilt-bh-prefix" prefix)
    (vlax-ldata-put "bilt-bh-dict" "bilt-bh-suffix" (itoa bh_suffix))
    (princ)
)