[LISP程序]：修改尺寸标注为楼梯标注形式（实用程序）

gysjy

;| 用途：修改尺寸标注为楼梯标注形式。例如，你如果选择了标注值分别为1650和1800的相关标注，输入步长为150，则标注值分别被改为“150X11=1650”和“150X12=1800”。
使用方法十分简单：
1.选择要改变的尺寸标注；
2.输入步长或踏步数，默认步长为260；
3.回车即完成了修改。
如紧接着再次使用该命令，则默认的范围为上次使用的步长。|;

2. 
   
3. (princ "\n修改尺寸标注为楼梯标注形式，\n比例为1：50，请执行ltdim；\n比例为1：100，请执行ltdim1。")
   
4. (defun c:ltdim(/ ss nn ssl n sn en p1 p2 dis3 dis0 t0 t1 t b m bs ms dis00 str)
   
5.    ;;全局变量: wxn0
   
6.    (setq oer *error* *error* myerr)
   
7.    (setvar "cmdecho" 0)
   
8.    (command "graphscr")
   
9.    (setq ss (ssget))
   
10.    (if (= wxn0 nil) (setq wxn0 260))
    
11.    (princ "\n步长或步数<") (princ wxn0)
    
12.    (setq nn (getint ">:"))
    
13.    (if (= nn nil) (setq nn wxn0))
    
14.      (setq ssl (sslength ss) n 0)
    
15.      (repeat ssl
    
16.        (setq sn (ssname ss n) en (entget sn) n (1+ n))
    
17.        (if (= "DIMENSION" (cdr (assoc 0 en)))
    
18.          (progn
    
19.            (setq p1 (cdr (assoc 13 en)) p2 (cdr (assoc 14 en))
    
20.                  dis3 (distance p1 p2) dis0 (* 5 (fix (/ (+ dis3 4) 10)))
    
21.                  t0 (/ dis3 nn)  t0 (/ t0 2) t1 (+ t0 0.5)  t (fix t1)
    
22.            )
    
23.            (if (> nn t) (setq b nn m t) (setq m nn b t))
    
24.            (setq bs (itoa b)  ms (itoa m)  diss0 (itoa dis0))
    
25.            (setq str (strcat bs "X" ms "=" diss0))
    
26.            (command "dim1" "newtext" str  sn "")
    
27.            (setq wxn0 nn)
    
28.          )
    
29.        )
    
30.        (princ (strcat str ";   "))
    
31.      )
    
32.      (princ "\n            gysjy0  96.8制作, 97.5修改.")
    
33.      (setq *error* oer)
    
34.      (princ))
    
35. 
    
36. (defun c:ltdim1(/ ss nn ssl n sn en p1 p2 dis3 dis0 t0 t1 t b m bs ms dis00 str)
    
37.    ;;全局变量: wxn0
    
38.    (setq oer *error* *error* myerr)
    
39.    (setvar "cmdecho" 0)
    
40.    (command "graphscr")
    
41.    (setq ss (ssget))
    
42.    (if (= wxn0 nil) (setq wxn0 260))
    
43.    (princ "\n步长或步数<") (princ wxn0)
    
44.    (setq nn (getint ">:"))
    
45.    (if (= nn nil) (setq nn wxn0))
    
46.      (setq ssl (sslength ss) n 0)
    
47.      (repeat ssl
    
48.        (setq sn (ssname ss n) en (entget sn) n (1+ n))
    
49.        (if (= "DIMENSION" (cdr (assoc 0 en)))
    
50.          (progn
    
51.            (setq p1 (cdr (assoc 13 en)) p2 (cdr (assoc 14 en))
    
52.                  dis3 (distance p1 p2) dis0 (* 10 (fix (/ (+ dis3 4) 10)))
    
53.                  t0 (/ dis3 nn)  t1 (+ t0 0.5)  t (fix t1)
    
54.            )
    
55.            (if (> nn t) (setq b nn m t) (setq m nn b t))
    
56.            (setq bs (itoa b)  ms (itoa m)  diss0 (itoa dis0))
    
57.            (setq str (strcat bs "X" ms "=" diss0))
    
58.            (command "dim1" "newtext" str  sn "")
    
59.            (setq wxn0 nn)
    
60.          )
    
61.        )
    
62.        (princ (strcat str ";   "))
    
63.      )
    
64.      (princ "\n            gysjy0  96.8制作, 97.5修改.")
    
65.      (setq *error* oer)
    
66.      (princ))
    
67. 
    
68. (defun myerr (s)
    
69.   (if (/= s "Function canccelled")
    
70.    (if (= (substr s 1 13) "null function")
    
71.        (princ "\n该程序不能运行.") (princ "\n程序中止")
    
72.    )
    
73.   )
    
74.   (setq *error* oer)
    
75.   (princ))

<br /> (princ "\n修改尺寸标注为楼梯标注形式，\n比例为1：50，请执行ltdim；\n比例为1：100，请执行ltdim1。")<br /> (defun c:ltdim(/ ss nn ssl n sn en p1 p2 dis3 dis0 t0 t1 t b m bs ms dis00 str)<br />    ;;全局变量: wxn0<br />    (setq oer *error* *error* myerr)<br />    (setvar "cmdecho" 0)<br />    (command "graphscr")<br />    (setq ss (ssget))<br />    (if (= wxn0 nil) (setq wxn0 260))<br />    (princ "\n步长或步数<") (princ wxn0) <br />    (setq nn (getint ">:"))<br />    (if (= nn nil) (setq nn wxn0))<br />      (setq ssl (sslength ss) n 0)<br />      (repeat ssl<br />        (setq sn (ssname ss n) en (entget sn) n (1+ n))<br />        (if (= "DIMENSION" (cdr (assoc 0 en)))<br />          (progn<br />            (setq p1 (cdr (assoc 13 en)) p2 (cdr (assoc 14 en))<br />                  dis3 (distance p1 p2) dis0 (* 5 (fix (/ (+ dis3 4) 10)))<br />                  t0 (/ dis3 nn)  t0 (/ t0 2) t1 (+ t0 0.5)  t (fix t1)<br />            )<br />            (if (> nn t) (setq b nn m t) (setq m nn b t))<br />            (setq bs (itoa b)  ms (itoa m)  diss0 (itoa dis0))<br />            (setq str (strcat bs "X" ms "=" diss0))<br />            (command "dim1" "newtext" str  sn "")<br />            (setq wxn0 nn)<br />          )<br />        )<br />        (princ (strcat str ";   "))<br />      )<br />      (princ "\n            gysjy0  96.8制作, 97.5修改.")<br />      (setq *error* oer)<br />      (princ))<br /> <br /> (defun c:ltdim1(/ ss nn ssl n sn en p1 p2 dis3 dis0 t0 t1 t b m bs ms dis00 str)<br />    ;;全局变量: wxn0<br />    (setq oer *error* *error* myerr)<br />    (setvar "cmdecho" 0)<br />    (command "graphscr")<br />    (setq ss (ssget))<br />    (if (= wxn0 nil) (setq wxn0 260))<br />    (princ "\n步长或步数<") (princ wxn0) <br />    (setq nn (getint ">:"))<br />    (if (= nn nil) (setq nn wxn0))<br />      (setq ssl (sslength ss) n 0)<br />      (repeat ssl<br />        (setq sn (ssname ss n) en (entget sn) n (1+ n))<br />        (if (= "DIMENSION" (cdr (assoc 0 en)))<br />          (progn<br />            (setq p1 (cdr (assoc 13 en)) p2 (cdr (assoc 14 en))<br />                  dis3 (distance p1 p2) dis0 (* 10 (fix (/ (+ dis3 4) 10)))<br />                  t0 (/ dis3 nn)  t1 (+ t0 0.5)  t (fix t1)<br />            )<br />            (if (> nn t) (setq b nn m t) (setq m nn b t))<br />            (setq bs (itoa b)  ms (itoa m)  diss0 (itoa dis0))<br />            (setq str (strcat bs "X" ms "=" diss0))<br />            (command "dim1" "newtext" str  sn "")<br />            (setq wxn0 nn)<br />          )<br />        )<br />        (princ (strcat str ";   "))<br />      )<br />      (princ "\n            gysjy0  96.8制作, 97.5修改.")<br />      (setq *error* oer)<br />      (princ))<br /> <br /> (defun myerr (s)<br />   (if (/= s "Function canccelled")<br />    (if (= (substr s 1 13) "null function")<br />        (princ "\n该程序不能运行.") (princ "\n程序中止")<br />    )<br />   )<br />   (setq *error* oer)<br />   (princ))