[LISP程序]：用于生成指定间距、方向、步长的数字(字母)列

lyc3029

桥梁设计经常要写节段号之类,呵呵,瞎写了一个,有用就拿去...



(princ "\n本程序用于生成指定间距、方向、步长的数字(字母)列. start command with wbh,written by lyc,10/2007.")
(defun C:wbh ( / pt fx bc thsize xx yy nn mth begin i pt1 dist osm)
(setq thsize (getvar "textsize"))(setq i 0)
(setvar "cmdecho" 0)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq pt (getpoint "\n请指定起始点:"))
(setq xx (car pt))(setq yy (cadr pt))
(setq mth (getint "\n请指定生成类型(1.数字/2.字母):<1>"))
(if (= mth nil) (setq mth 1))
   (if (= mth 1)
       (progn
       (setq begin (getint  "\n请指定起始数字:<1>" ))
       (if (= begin nil) (setq begin 1))
        )
       (progn
       (setq begin (getstring  "\n请指定起始字母:<A>" ))
       (if (= begin "") (setq begin "A"))
        )
   )
     
(setq bc (getreal "\n请输入间距:<10>"))
(if (= bc nil) (setq bc 10))
(setq dist (getreal "\n请输入步长:<1>"))
(if (= dist nil) (setq dist 1))
(setq nn (getint "\n请输入生成个数:<10>"))
(if (= nn nil) (setq nn 10))

  
(setq fx (getstring "\n请指定生成方向(X/Y):<X>"))


(if (= mth 1)

(progn  ;;;;;;;;;;;;;11111111111111用于生成数字
  
(if (= fx "") (setq fx "x"))

  (if (or (= fx "X") (= fx "x"))
     (progn
         (while (< i nn)
         (setq pt1 (list xx yy))
         (command "text" "j" "m" pt1  thsize  0  (rtos begin 2 0))
         (setq i (+ i 1))
         (setq begin (+ begin dist))
         (setq xx (+ xx bc))
         )       
      )
     (progn
         (while (< i nn)
         (setq pt1 (list xx yy))
         (command "text" "j" "m" pt1  thsize  0  (rtos begin 2 0))
         (setq i (+ i 1))
         (setq begin (+ begin dist))
         (setq yy (+ yy bc))
         )       
      )
  )

);;;;;;;;;;;;;11111111111111用于生成数字

  
(progn  ;;;;;;;;;;;;;2222222222222222用于生成字母
  
(if (= fx "") (setq fx "x"))

  (if (or (= fx "X") (= fx "x"))
     (progn
         (while (< i nn)
         (setq pt1 (list xx yy))
         (command "text" "j" "m" pt1  thsize  0    begin )
         (setq i (+ i 1))
         (setq begin    (chr   ( fix (+ ( ascii begin) dist) )  )     )
         (setq xx (+ xx bc))
         )       
      )
     (progn
         (while (< i nn)
         (setq pt1 (list xx yy))
         (command "text" "j" "m" pt1  thsize  0    begin  )
         (setq i (+ i 1))
         (setq begin    (chr   ( fix (+ ( ascii begin) dist) )  )     )
         (setq yy (+ yy bc))
         )       
      )
  )

);;;;;;;;;;;;;2222222222222222222用于生成字母

  
)
  
(setvar "cmdecho" 1)(setvar "osmode" osm)
(princ)
)

guoxiaowei

什么

pipeng611

这个小程序很好用
谢谢楼主
最好可以修改一下数字可以支持前加字母后缀，这样更实用

lyc3029

呵呵，加后缀比较罗嗦，加不是什么难事，你想咋个加法？

pipeng611

如YCK100、YCK200、Z3-SZM2-100、Z3-SZM2-200等

zml84

楼主也是桥梁专业的，同行啊，支持一下！

lyc3029

谢谢楼上，哈哈
应３楼要求，改了一下，呵呵，有点冗长，呵，主要没时间搞子程了，功能反正是满足了，添加增加前后缀的功能（字母／数字都可以）．

(princ "\n本程序用于生成指定间距、方向、步长的数字(字母)列. start command with wbh,written by lyc,10/2007.")
(defun C:wbh ( / pt fx bc thsize xx yy nn mth begin i pt1 dist osm qhz qhzn)
(setq thsize (getvar "textsize"))(setq i 0)
(setvar "cmdecho" 0)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq pt (getpoint "\n请指定起始点:"))
(setq xx (car pt))(setq yy (cadr pt))
(setq mth (getint "\n请指定生成类型(1.数字/2.字母):<1>"))
(if (= mth nil) (setq mth 1))
(if (= mth 1)
(progn
(setq begin (getint "\n请指定起始数字:<1>" ))
(if (= begin nil) (setq begin 1))
)
(progn
(setq begin (getstring "\n请指定起始字母:<A>" ))
(if (= begin "") (setq begin "A"))
)
)

(setq bc (getreal "\n请输入间距:<10>"))
(if (= bc nil) (setq bc 10))
(setq dist (getreal "\n请输入步长:<1>"))
(if (= dist nil) (setq dist 1))
(setq nn (getint "\n请输入生成个数:<10>"))
(if (= nn nil) (setq nn 10))

;;;;;是否加入前后缀
(setq qhz (getint "\n是否加入前后缀(0.不加1.前缀/2.后缀):<0>"))
(if (or (= qhz nil) (= qhz 0)) (setq qhz 0) (setq qhzn (getstring "\请前缀(后缀):")))
(if (= qhzn nil) (setq qhzn ""))
;;;;;是否加入前后缀

(setq fx (getstring "\n请指定生成方向(X/Y):"))


(if (= qhz 0)


(progn   ;;;;;;;;;;;;;;;;;;;;;;;无前后缀

(if (= mth 1)

(progn ;;;;;;;;;;;;;11111111111111用于生成数字

(if (= fx "") (setq fx "x"))

(if (or (= fx "X") (= fx "x"))
(progn
(while (< i nn)
(setq pt1 (list xx yy))
(command "text" "j" "m" pt1 thsize 0 (rtos begin 2 0))
(setq i (+ i 1))
(setq begin (+ begin dist))
(setq xx (+ xx bc))
)
)
(progn
(while (< i nn)
(setq pt1 (list xx yy))
(command "text" "j" "m" pt1 thsize 0 (rtos begin 2 0))
(setq i (+ i 1))
(setq begin (+ begin dist))
(setq yy (+ yy bc))
)
)
)

);;;;;;;;;;;;;11111111111111用于生成数字


(progn ;;;;;;;;;;;;;2222222222222222用于生成字母

(if (= fx "") (setq fx "x"))

(if (or (= fx "X") (= fx "x"))
(progn
(while (< i nn)
(setq pt1 (list xx yy))
(command "text" "j" "m" pt1 thsize 0 begin )
(setq i (+ i 1))
(setq begin (chr ( fix (+ ( ascii begin) dist) ) ) )
(setq xx (+ xx bc))
)
)
(progn
(while (< i nn)
(setq pt1 (list xx yy))
(command "text" "j" "m" pt1 thsize 0 begin )
(setq i (+ i 1))
(setq begin (chr ( fix (+ ( ascii begin) dist) ) ) )
(setq yy (+ yy bc))
)
)
)

);;;;;;;;;;;;;2222222222222222222用于生成字母

)

) ;;;;;;;;;;;;;;;;;;;;无前后缀


;;;;;;;;;;以下为有前后缀

(if (= qhz 1)

(progn   ;;;;;;;;;;;;;;;;;;;;;;;前缀

(if (= mth 1)

(progn ;;;;;;;;;;;;;11111111111111用于生成数字

(if (= fx "") (setq fx "x"))

(if (or (= fx "X") (= fx "x"))
(progn
(while (< i nn)
(setq pt1 (list xx yy))
(command "text" "j" "m" pt1 thsize 0 (strcat  qhzn (rtos begin 2 0) ))
(setq i (+ i 1))
(setq begin (+ begin dist))
(setq xx (+ xx bc))
)
)
(progn
(while (< i nn)
(setq pt1 (list xx yy))
(command "text" "j" "m" pt1 thsize 0 (strcat  qhzn (rtos begin 2 0) ))
(setq i (+ i 1))
(setq begin (+ begin dist))
(setq yy (+ yy bc))
)
)
)

);;;;;;;;;;;;;11111111111111用于生成数字


(progn ;;;;;;;;;;;;;2222222222222222用于生成字母

(if (= fx "") (setq fx "x"))

(if (or (= fx "X") (= fx "x"))
(progn
(while (< i nn)
(setq pt1 (list xx yy))
(command "text" "j" "m" pt1 thsize 0 (strcat  qhzn begin) )
(setq i (+ i 1))
(setq begin (chr ( fix (+ ( ascii begin) dist) ) ) )
(setq xx (+ xx bc))
)
)
(progn
(while (< i nn)
(setq pt1 (list xx yy))
(command "text" "j" "m" pt1 thsize 0 (strcat  qhzn begin)  )
(setq i (+ i 1))
(setq begin (chr ( fix (+ ( ascii begin) dist) ) ) )
(setq yy (+ yy bc))
)
)
)

);;;;;;;;;;;;;2222222222222222222用于生成字母

)

) ;;;;;;;;;;;;;;;;;;;;前缀


(progn   ;;;;;;;;;;;;;;;;;;;;;;;;;;后缀

(if (= mth 1)

(progn ;;;;;;;;;;;;;11111111111111用于生成数字

(if (= fx "") (setq fx "x"))

(if (or (= fx "X") (= fx "x"))
(progn
(while (< i nn)
(setq pt1 (list xx yy))
(command "text" "j" "m" pt1 thsize 0 (strcat   (rtos begin 2 0) qhzn ))
(setq i (+ i 1))
(setq begin (+ begin dist))
(setq xx (+ xx bc))
)
)
(progn
(while (< i nn)
(setq pt1 (list xx yy))
(command "text" "j" "m" pt1 thsize 0 (strcat (rtos begin 2 0)   qhzn ))
(setq i (+ i 1))
(setq begin (+ begin dist))
(setq yy (+ yy bc))
)
)
)

);;;;;;;;;;;;;11111111111111用于生成数字

(progn ;;;;;;;;;;;;;2222222222222222用于生成字母

(if (= fx "") (setq fx "x"))

(if (or (= fx "X") (= fx "x"))
(progn
(while (< i nn)
(setq pt1 (list xx yy))
(command "text" "j" "m" pt1 thsize 0 (strcat   begin qhzn) )
(setq i (+ i 1))
(setq begin (chr ( fix (+ ( ascii begin) dist) ) ) )
(setq xx (+ xx bc))
)
)
(progn
(while (< i nn)
(setq pt1 (list xx yy))
(command "text" "j" "m" pt1 thsize 0 (strcat   begin qhzn) )
(setq i (+ i 1))
(setq begin (chr ( fix (+ ( ascii begin) dist) ) ) )
(setq yy (+ yy bc))
)
)
)

);;;;;;;;;;;;;2222222222222222222用于生成字母

);;;;;;;;;;;;;;;;;;;;后缀

) ;;;;;;;;;;;;;;;;;;;;前后缀



);;;;有无前后缀


)

(setvar "cmdecho" 1)(setvar "osmode" osm)
(princ)
)

pipeng611

修改后的很实用哈
前后缀都可以加
谢谢搂住，辛苦了！