[源码] 以最短的字符串降低块名重复的方法

admin

经常会遇到不同图纸粘贴块参照的现象，如果两个图纸中相同块名其结构不同，粘贴会出问题，这里给出来一种方法，可以降低重复几率

1. (defun $make-block-name$ (/ $msec/52$ f m n r s str wm y zz)
   
2.   ;制作块名
   
3.   (defun $msec/52$ (n zz / d ds loop n1 str)
   
4.           ;52进制转换为字母
   
5. 
   
6.     (or  n
   
7.   (setq n (atoi (menucmd "M=$(edtime,$(getvar,date),MSEC)")))
   
8.     )
   
9.     (setq ds nil)
   
10.     (setq loop T)
    
11.     (while loop
    
12.       (if (= (setq n1 (/ n 52)) 0)
    
13.   (setq loop nil)
    
14.       )
    
15.       (setq d (rem n 52))
    
16.       (setq ds (cons d ds))
    
17.       (setq n n1)
    
18.     )
    
19.     (setq
    
20.       str (apply 'strcat
    
21.      (mapcar (function (lambda (a) (nth a zz))) ds)
    
22.     )
    
23.     )
    
24.     str
    
25.   )
    
26.   (SETQ  ZZ (list "A"   "B"   "C"   "D"   "E"   "F"   "G"   "H"   "I"
    
27.      "J"   "K"   "L"   "M"   "N"   "O"   "P"   "Q"   "R"
    
28.      "S"   "T"   "U"   "V"   "W"   "X"   "Y"   "Z"   "A"
    
29.      "a"   "b"   "c"   "d"   "e"   "f"   "g"   "h"   "i"
    
30.      "j"   "k"   "l"   "m"   "n"   "o"   "p"   "q"   "r"
    
31.      "s"   "t"   "u"   "v"   "w"   "x"   "y"   "z"   "a"
    
32.     )
    
33.   )
    
34.   (setq
    
35.     n ($msec/52$
    
36.   (atoi (menucmd "M=$(edtime,$(getvar,date),YYYY)"))
    
37.   zz
    
38.       )
    
39.   )          ;年
    
40.   (setq y (nth (atoi (menucmd "M=$(edtime,$(getvar,date),M)")) zz))
    
41.           ;月
    
42.   (setq R (nth (atoi (menucmd "M=$(edtime,$(getvar,date),D)")) zz))
    
43.           ;日
    
44.   (setq s (nth (atoi (menucmd "M=$(edtime,$(getvar,date),HH)")) zz))
    
45.           ;时
    
46.   (setq  F ($msec/52$ (atoi (menucmd "M=$(edtime,$(getvar,date),MM)"))
    
47.          zz
    
48.     )
    
49.   )
    
50.           ;分
    
51.   (setq  M ($msec/52$ (atoi (menucmd "M=$(edtime,$(getvar,date),SS)"))
    
52.          zz
    
53.     )
    
54.   )          ;秒
    
55.   (SETQ WM ($msec/52$ NIL zz))    ;微妙
    
56.   (setq str (strcat n y r S F M WM))
    
57.   str
    
58. )

复制代码