[源码]简单序号累加
本帖最后由 004 于 2014-5-11 02:38 编辑;wkq00420140331
(PRINC "序号球004，启动命令：xh")
(defun c:xh (/ ss)
(setvar "cmdecho" 0)
(if (setq layerE (tblobjname "layer" "004序号"))
(progn
(setq layerEL (entget layerE))
(setq ass62 (assoc 62 layerEL))
(if(/= 4 (cdr ass62))
(progn (setq layerEL (subst (cons 62 4) ass62 layerEL))
(entmod layerEL)
)
)
)
(entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
'(6 . "Continuous")
'(62 . 4)
(cons 2 "004序号")
)
)
)
(defun *error* (msg)
(princ "\n取消!")
(command "_.erase" SS "")
(command ".undo" "end")
(setq *error* nil)
)
(defun fun-xh004 ()
(if(null xh004)
(progn (setq xh004 "1")
(setq xh004 (itoa (getint "\n请输入起始序号[]<1>：")))
)
)
)
(defun rr004 ()
(if(null r004)
(progn
(command ".circle"
(getpoint "\n点取设置序号球半径的大小><:")
pause
)
(setq r004 (getvar "CIRCLERAD"))
(entdel (entlast))
)
)
)
(fun-xh004)
(rr004)
(defun msg ()
(princ
"\n点击放置序号球[右键退出/S设置序号/R设置序号球半径]<左键放置>："
)
)
(msg)
(defun main ()
(command ".undo" "begin")
(setq ss (ssadd))
(setq TEST t)
(setq a nil)
(while TEST
(setq TMP (grread t 7 1))
(cond
((= (car TMP) 3) ;_左键
(setq xh004 (itoa (1+ (atoi xh004))))
(setq TEST NIL)
(setq a T)
)
((= (car TMP) 25) ;_右键
(command "_.erase" SS "")
(setq TEST NIL)
)
((= (car TMP) 5) ;_移动
(setq PT (cadr TMP))
(command "_.erase" SS "")
(entmake
(list '(0 . "TEXT")
'(8 . "004序号")
'(62 . 256)
'(7 . "fs")
(cons 1 xh004)
(cons 10 pt)
(cons 40 r004)
)
)
(ssadd (entlast) ss)
)
((and (OR (equal (cadr TMP) 114) (equal (cadr TMP) 82))
(equal (car TMP) 2)
) ;_序号球半径
(progn
(command ".circle"
(getpoint "\n点取设置序号球半径的大小><:")
pause
)
(setq r004 (getvar "CIRCLERAD"))
(princ r004)
(msg)
(entdel (entlast))
(setq TEST NIL)
(setq a T)
)
)
((and (OR (equal (cadr TMP) 83) (equal (cadr TMP) 115))
(equal (car TMP) 2)
) ;_设置序号
(command "_.erase" SS "")
(setq xh004 (itoa (getint "\n请输入序号：")))
(msg)
(setq TEST NIL)
(setq a T)
)
(t
(princ TMP)
)
)
) ;_结束 while
(command ".undo" "end")
)
(main)
(while a
(main)
)
(princ)
)
页:
[1]