自己编的一些LISP程序,以下程序适合批量化处理数据

;自身乘一个倍数
(DEFUN C:zc1()
(setvar "cmdecho" 0)
(PRINT "(Copyright- aningtang)")
(SETQ s0 (GETREAL "请输入乘数:"))
(PRINT "PLEASE SELECT THE object")
(SETQ S (SSGET ))
(SETQ N (SSLENGTH S))
(SETQ M 0)
(REPEAT N
(SETQ SN (SSNAME S M))
(SETQ e (ENTGET SN))
(IF (= (cdr (assoc 0 e)) "TEXT")
(PROGN
(setq oldr (assoc 1 e))
(setq old0 (cdr oldr))
(setq newr (rtos (* (atof old0) s0) 2 1))
(setq e1 (subst (cons (car (assoc 1 e)) newr) (assoc 1 e) e))
(entmod e1)
)
)
(SETQ M (+ M 1))
)
)
;自身除一个倍数
(DEFUN C:zc2()
(setvar "cmdecho" 0)
(PRINT "(Copyright- aningtang)")
(SETQ s0 (GETREAL "请输入被除数:"))
(PRINT "PLEASE SELECT THE object")
(SETQ S (SSGET ))
(SETQ N (SSLENGTH S))
(SETQ M 0)
(REPEAT N
(SETQ SN (SSNAME S M))
(SETQ e (ENTGET SN))
(IF (= (cdr (assoc 0 e)) "TEXT")
(PROGN
(setq oldr (assoc 1 e))
(setq old0 (cdr oldr))
(setq newr (rtos (/ (atof old0) s0) 2 1))
(setq e1 (subst (cons (car (assoc 1 e)) newr) (assoc 1 e) e))
(entmod e1)
)
)
(SETQ M (+ M 1))
)
)

;自身加一个数
(DEFUN C:zj1()
(setvar "cmdecho" 0)
(PRINT "(Copyright- aningtang)")
(SETQ s0 (GETREAL "请输入增加的数值:"))
(PRINT "PLEASE SELECT THE object")
(SETQ S (SSGET ))
(SETQ N (SSLENGTH S))
(SETQ M 0)
(REPEAT N
(SETQ SN (SSNAME S M))
(SETQ e (ENTGET SN))
(IF (= (cdr (assoc 0 e)) "TEXT")
(PROGN
(setq oldr (assoc 1 e))
(setq old0 (cdr oldr))
(setq newr (rtos (+ (atof old0) s0) 2 1))
(setq e1 (subst (cons (car (assoc 1 e)) newr) (assoc 1 e) e))
(entmod e1)
)
)
(SETQ M (+ M 1))
)
)

;自身减一个数
(DEFUN C:zj2()
(setvar "cmdecho" 0)
(PRINT "(Copyright- aningtang)")
(SETQ s0 (GETREAL "请输入减少的数值:"))
(PRINT "PLEASE SELECT THE object")
(SETQ S (SSGET ))
(SETQ N (SSLENGTH S))
(SETQ M 0)
(REPEAT N
(SETQ SN (SSNAME S M))
(SETQ e (ENTGET SN))
(IF (= (cdr (assoc 0 e)) "TEXT")
(PROGN
(setq oldr (assoc 1 e))
(setq old0 (cdr oldr))
(setq newr (rtos (- (atof old0) s0) 2 1))
(setq e1 (subst (cons (car (assoc 1 e)) newr) (assoc 1 e) e))
(entmod e1)
)
)
(SETQ M (+ M 1))
)
)

[ 本帖最后由 erjijiegou2 于 2010-10-21 22:00 编辑 ]

erjijiegou2

2010年10月21日 20:52:40

2楼

;;;批量改圆直径
(DEFUN C:qb()
(setvar "cmdecho" 0)
(PRINT "(Copyright- aningtang)")
(SETQ new_d (GETREAL "请输入圆的直径D:"))
(SETQ new (/ new_d 2))
(PRINT "PLEASE SELECT THE object")
(SETQ S (SSGET ))
(SETQ N (SSLENGTH S))
(SETQ M 0)
(REPEAT N
(SETQ SN (SSNAME S M))
(SETQ e (ENTGET SN))
(IF (= (cdr (assoc 0 e)) "CIRCLE")
(PROGN
(setq oldr (assoc 40 e))
(setq newr (cons 40 new))
(setq e (subst newr oldr e))
(entmod e)
(print bl)

)
)
(SETQ M (+ M 1))
)
)

[ 本帖最后由 erjijiegou2 于 2010-11-22 10:10 编辑 ]

erjijiegou2

2010年10月21日 20:53:49

3楼

;;使所选直线绕中心旋转90度
( defun c:rrrr()
(setq aa (cadr (entsel)))
(command "rotate" aa "" "mid" aa 90 "")
)

erjijiegou2

2010年10月21日 20:58:20

4楼

;点批量生成球程序
(DEFUN C:psph()
(PRINT "(Copyright- aningtang)")
(PRINT "点批量生成球程序")
(SETQ DX (GETREAL "请输入球的直径 D:"))
(PRINT "PLEASE SELECT THE point")
(SETQ S (SSGET ))
(SETQ N (SSLENGTH S))
(SETQ M 0)
(REPEAT N
(SETQ SN (SSNAME S M))
(SETQ SNV (ENTGET SN))
(PRINT (ASSOC 1 SNV))
(IF (= (CDR (ASSOC 0 SNV)) "POINT")
(PROGN
(PRINT M)
(SETQ Z1 (CDR (ASSOC 10 SNV)))
(command "_sphere" Z1 "d" "" DX )
))
(SETQ M (+ M 1))

)
)

erjijiegou2

2010年10月21日 21:00:56

5楼

批量标注直线两端坐标

erjijiegou2

2010年10月21日 21:03:46

6楼

自己编的LISP源码

erjijiegou2

2010年10月21日 21:08:24

7楼

自己编的LISP程序源码

erjijiegou2

2010年10月21日 21:09:20

8楼

;单向插入法求值程序
(defun C:ca()
(PRINT "(Copyright- aningtang)")
(PRINC "单向插入法求值程序： " )
(setq A1 (getreal " 请输入X方向原值A1 :"))
(setq A2 (getreal " 请输入X方向原值A2 :"))
(setq B1 (getreal " 请输入X方向原值B1 :"))
(setq B2 (getreal " 请输入X方向原值B2 :"))
(setq A (getreal " 请输入X方向插入值A :"))
(setq B (- B1 (/ (* (- A1 A) (- B1 B2)) (- A1 A2))))
(PRINC "求得值B= " ) (PRINT B)
)

erjijiegou2

2010年10月21日 21:13:57

9楼

定长度对齐尺寸程序

erjijiegou2

2010年10月21日 21:30:58

10楼

;在交点处打断
(defun c:bbc()
(PRINT "(Copyright- aningtang)")
(setvar "osmode" 32)
(setq pt2 (getpoint "\nBreak point : "))
(setq en1 (ssget))
(if en1
(progn
(setq cc 0)
(repeat (sslength en1)
(setq aa (ssname en1 cc))
(command "break" aa pt2 pt2)
(setq cc (1+ cc))
)
)
)

(prin1)
)

erjijiegou2

2010年10月21日 21:33:42

11楼

多重复制程序LISP源码