[LISP程序]：改進後的球標智能標注程序原碼

xtjd

命令行輸入  num          or             num_01

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
(defun c:num( / cc i ien it lay nn os te tt)
  (lspst)
  (princ "球標標注程式")
  (setq tt (getreal "\n請輸入字體的大小<2.5>：")) (if (null tt) (setq tt 2.5))
  (setq cc (* 2 tt))
  (setq te (getint "\n請輸入起始值的大小<1>：")) (if (null te) (setq te 1))
  (setq it te)
  (setq i 0)
  (if (setq nn (getpoint "\n請選擇初始球標的放置點："))
    (progn
      (while nn
        (setvar "osmode" 0)
        (setq lay (getvar "clayer"))
        (if (null (tblsearch "layer" "cirdim"))
          (command ".layer" "m" "CIRDIM" "")
          (command ".layer" "t" "cirdim" "s" "cirdim" "")
        )
        (command ".circle" nn "d" cc)
        (command ".text" "j" "m" nn tt "" te)
        (command ".layer" "s" lay "")
        (setq te (1+ te))
        (setq ien (+ i it))
        (setq i (1+ i))        
        (setvar "osmode" os)
        (princ  (strcat "\n下一個球標"(itoa te)"的放置點："))
        (setq nn (getpoint))
      )
      (princ (strcat "－－－－－★　總共作了" (itoa i) "個球標標注，起始值為：" (itoa it) "、終止值為：" (itoa ien)"　★－－－－－"))
    )
    (progn
      (princ "\n無任何動作，程式退出！")
    )
  )      
  (lspend)  
)

(defun c:num_01( / cc i ien it lay nn os te tt te1 te2)
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode")
  (command ".undo" "be")
  (princ "球標標注程式")
  (setq tt (getreal "\n請輸入字體的大小<2.5>：")) (if (null tt) (setq tt 2.5))
  (setq cc (* 3 tt))
  (setq te1 (getstring "請輸入起始標頭<A1>："))(if (= te1 "") (Setq te1 "A1"))
  (if (= (strlen te1) 2)
    (Setq te (atoi (substr te1 2 1)))
    (Setq te (atoi (substr te1 2 2)))
  )
  (setq it te)
  (setq i 0)
  (if (setq nn (getpoint "\n請選擇初始球標的放置點："))
    (progn
      (while nn
        (setvar "osmode" 0)
        (setq lay (getvar "clayer"))
        (if (null (tblsearch "layer" "cirdim"))
          (command ".layer" "m" "CIRDIM" "")
          (command ".layer" "t" "cirdim" "s" "cirdim" "")
        )
        (command ".circle" nn "d" cc)
        (Setq te2 (strcat (substr te1 1 1) (itoa te)))
        (command ".text" "j" "m" nn tt "" te2)
        (command ".layer" "s" lay "")
        (setq te (1+ te))
        (setq ien (+ i it))
        (setq i (1+ i))        
        (setvar "osmode" os)
        (princ  (strcat "\n下一個球標"(substr te1 1 1)(itoa te)"的放置點："))
        (setq nn (getpoint))
      )
      (princ (strcat "★總共作了" (itoa i) "個球標標注，起始值為：" (itoa it) "、終止值為：" (itoa ien) "，其中標頭為< " (substr te1 1 1)" >""★"))
    )
    (progn
      (princ "\n無任何動作，程式退出！")
    )
  )
  (setvar "osmode" os)      
  (setvar "cmdecho" 1)
  (prin1)  
)

lsjjm

1. (lspst), (lspend) 函数未定义;
2. (setq os (getvar "osmode") 后缺少一个 ")";
3 不能连续生成.

xtjd

(defun c:num( / cc i ien it lay nn os te tt)
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(command ".undo" "be")
(princ "球標標注程式")
(setq tt (getreal "\n請輸入字體的大小<2.5>：")) (if (null tt) (setq tt 2.5))
(setq cc (* 2 tt))
(setq te (getint "\n請輸入起始值的大小<1>：")) (if (null te) (setq te 1))
(setq it te)
(setq i 0)
(if (setq nn (getpoint "\n請選擇初始球標的放置點："))
(progn
(while nn
(setvar "osmode" 0)
(setq lay (getvar "clayer"))
(if (null (tblsearch "layer" "cirdim"))
(command ".layer" "m" "CIRDIM" "")
(command ".layer" "t" "cirdim" "s" "cirdim" "")
)
(command ".circle" nn "d" cc)
(command ".text" "j" "m" nn tt "" te)
(command ".layer" "s" lay "")
(setq te (1+ te))
(setq ien (+ i it))
(setq i (1+ i))
(setvar "osmode" os)
(princ (strcat "\n下一個球標"(itoa te)"的放置點："))
(setq nn (getpoint))
)
(princ (strcat "－－－－－★　總共作了" (itoa i) "個球標標注，起始值為：" (itoa it) "、終止值為：" (itoa ien)"　★－－－－－"))
)
(progn
(princ "\n無任何動作，程式退出！")
)
)
(setvar "osmode" os)
(setvar "cmdecho" 1)
(prin1)
)

(defun c:num_01( / cc i ien it lay nn os te tt te1 te2)
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(command ".undo" "be")
(princ "球標標注程式")
(setq tt (getreal "\n請輸入字體的大小<2.5>：")) (if (null tt) (setq tt 2.5))
(setq cc (* 3 tt))
(setq te1 (getstring "請輸入起始標頭："))(if (= te1 "") (Setq te1 "A1"))
(if (= (strlen te1) 2)
(Setq te (atoi (substr te1 2 1)))
(Setq te (atoi (substr te1 2 2)))
)
(setq it te)
(setq i 0)
(if (setq nn (getpoint "\n請選擇初始球標的放置點："))
(progn
(while nn
(setvar "osmode" 0)
(setq lay (getvar "clayer"))
(if (null (tblsearch "layer" "cirdim"))
(command ".layer" "m" "CIRDIM" "")
(command ".layer" "t" "cirdim" "s" "cirdim" "")
)
(command ".circle" nn "d" cc)
(Setq te2 (strcat (substr te1 1 1) (itoa te)))
(command ".text" "j" "m" nn tt "" te2)
(command ".layer" "s" lay "")
(setq te (1+ te))
(setq ien (+ i it))
(setq i (1+ i))
(setvar "osmode" os)
(princ (strcat "\n下一個球標"(substr te1 1 1)(itoa te)"的放置點："))
(setq nn (getpoint))
)
(princ (strcat "★總共作了" (itoa i) "個球標標注，起始值為：" (itoa it) "、終止值為：" (itoa ien) "，其中標頭為< " (substr te1 1 1)" >""★"))
)
(progn
(princ "\n無任何動作，程式退出！")
)
)
(setvar "osmode" os)
(setvar "cmdecho" 1)
(prin1)
)

Michael_66

球标标注是什么意思？

xtjd

己驗證，可以連續標注。