2008年11月10日星期一

自动递增减修改文字的AutoLisp程序

工作之余的小作品。希望有人能用。已经停止修改很久了,使用还算正常,虽然使用率不是很高。也当个成果保留下来吧。

重新看代码,发现有几处忘了:
(/= (getvar "errno") 52) 是获取错误代码,52是图元选择时,响应为空。
(initget "Reverse Forward Back Exit ") 是设置关键字,让下面的entsel函数可以响应关键字

stepmodify0.02RC1.LSP 全文如下:

;**********************************************************************
;Thanks to HKTK.GZDI www.mjtd.com www.xdcad.net www.cadvault.com
;Program by ScCat at GZDI(www.gzdi.com)
;email:seusccat@yahoo.com.cn
;The program is not so good ,please help and perfect it.
;Usage:Type "StepModify" to lauch the function
;Please remain the words above if you quote the code below
;***********************************************************************

;0.01版本,参考stepcopy0.07.lsp的c:stepcopy进行修改
;0.02版本,因为AutoCAD的选择经常选不到,在选择基准数时增加循环,在选择改变数时取消无选择退出,只能选ESC或鼠标右键退出
;0.02版本,增加反向,后退,前进功能
;0.02RC1,改正(initget "\nReverse Forward Back Exit")导致的不能反向
;0.02RC1,改正(if (< counter 1)(setq counter 0)) 导致出现0值
;0.02RC2 20081111 增加空格归1功能 改(initget "Reverse Forward Back Exit
") ;反转 前进 后退 退出 空格归1
;0.02RC2 20081111 增加空格归1功能 改((and (= 'STR (type input)) (eq input
""))(setq counter (- 1 factor)) ;空格归1(下一次)

;;;(prompt "\n Thanks for using StepModify beta 0.01")
;;;(prompt "\n Program by ScCat at GZDI")
;;;(prompt "\n www.gzdi.com")
;;;(prompt "\n email:seusccat@yahoo.com.cn")
;;;(prompt "\n Thanks HKTK.GZDI www.mjtd.com www.xdcad.net")
;;;(prompt
;;; "\n Type StepModify to launch the program,use Left mouse button
to StepModify"
;;;)
;;;(prompt "\n use Right mouse button Or ESC to quit")
(prompt
"\n 输入StepModify开始程序,鼠标左键进行递增修改,选ESC或鼠标右键退出"
)

;;;(defun C:show (/ p1 p2 e1 elist i counter) ;方便查看对象
;;; (setq ret (entsel "choose a object"))
;;; (setq e1 (car ret))
;;; (setq p1 (cadr ret))
;;; (print p1)
;;; (setq elist (entget e1)) ;返回对象
;;; (setq i 0)
;;; (textpage)
;;; (repeat (length elist)
;;; (print (nth i elist)) ;输出对象属
;;; (setq i (+ i 1))
;;; )
;;; (princ)
;;;
;;;)

(defun C:StepModify (/ p1 p2 e1 elist i counter)
;;定义出错
(defun myerror (msg)
(setvar "osmode" os) ;恢复捕捉状态
;;;在这里可以加入你所要执行的
;;;(ENTDEL E1) ;删除最后一个对象stepcopy保留的
(setq *error* olderr) ;恢复原来的出错函数
(princ)
)
(setq olderr *error* ;保存旧出错处理函数
*error* myerror ;设置新出错处理函数
)

(setq os (getvar "osmode")) ;保存程序开始前的捕捉状态

;;; (IF (AND (setq e1 (car (entsel "Please Choose A Text:")))
;;; ;如果选择的对象是字,分出末尾的数字和前
;;; (SETQ ED1 (ENTGET E1))
;;; (= "TEXT" (CDR (ASSOC 0 ED1)))
;;; (setq text (CDR (ASSOC 1 ED1)))
;;; )
(setvar "errno" 0)
(setq input (entsel "\n Please Choose A Text:"))

(while ;0.02版增加选择循环
(and
(/= (getvar "errno") 52)
(not
(AND
(setq e1 (car input))
(SETQ ED1 (ENTGET E1)) ;利用上面的nil和运算的简化避免错误
(= "TEXT" (CDR (ASSOC 0 ED1)))
)
)
)

(setq input (entsel "\n Please Choose A Text:"))
)


(if (/= (getvar "errno") 52) ;如果选择的对象是字,分出末尾的数字和前
(progn
(setq text (CDR (ASSOC 1 ED1)))
(setq len (strlen text))
(setq finish 0)
(while (= finish 0)
(if (and (> len 0)
(setq this (ascii (substr text len 1)))
(< this (+ (ascii "9") 1))
(> this (- (ascii "0") 1))
)
(progn
(setq len (- len 1))
)
(setq finish 1)
)
)
(setq prefix (substr text 1 len))
;(print prefix)
(setq
counter (atoi (substr text (+ len 1) (- (strlen text) len)))
)
;(print counter)
)
)

;;; )

;(setq p1 (getpoint "\n 文字的开始位置"))
(SETQ CANCLE 0)
(setq factor 1)
(while (and (= 0 CANCLE) (/= (getvar "errno") 52))
;(setq counter origincounter)
(progn
(SETQ COUNTERTEXT (ITOA COUNTER))
(setq text (strcat prefix countertext))
(setvar "errno" 0)
(initget "Reverse Forward Back Exit ") ;反转 前进 后退 退出 归1
(setq input (entsel (strcat "\n Next text would be \""
text
"\"+"
"("
(itoa factor)
")"
"/(Reverse/Forward/Back):"
)
)
)
(cond
((and (= 'STR (type input)) (eq input "Reverse"))
(setq factor (* factor -1)) ;反转
)
((and (= 'STR (type input)) (eq input "Forward"))
(setq counter (+ counter factor)) ;前进
)
((and (= 'STR (type input)) (eq input "Back"))
(setq counter (- counter (* 2 factor))) ;后退
)
((and (= 'STR (type input)) (eq input ""))
(setq counter (- 1 factor)) ;空格归1
)
((or (= (getvar "errno") 52) ;右键退出(7为空选,52为右键)
(and (= 'STR (type input))
(or (eq input " ") (eq input "Exit"))
)
)
(setq Cancle 1) ;空格,Exit退出
)

( ;(print (strcat "Next text would be " text))

(AND
(setq e1 (car input))
(SETQ e1lst (ENTGET E1))
(= "TEXT" (CDR (ASSOC 0 e1lst)))
)

(progn
(setq counter (+ counter factor))
(if (< counter 1)
(setq counter 1)
) ;counter不能小于1
(SETQ COUNTERTEXT (ITOA COUNTER))
;;; (SETQ digit (strlen countertext))
;;; (print (- len digit))
(setq text (strcat prefix countertext))

(setq e1lst (subst (CONS 1 TEXT)
(assoc 1 e1lst)
e1lst
)
)

(entmod e1lst)
(entupd e1)
)
;;; (setq cancle 1) ;0.02取消因选择不到而退出循环
)
)
)

)

;;结束部分
(setq *error* olderr) ;恢复原来的出错处理函数
;;; (princ "\nhere!\n")
(setvar "osmode" os) ;恢复捕捉状态会有显示
) ;C:StepModify结束

没有评论: