配色: 字号:
CAD批量文本计算器-V2.0
2023-07-24 | 阅:  转:  |  分享 
  
;;;CAD lisp小工具之批量文本数学运算

;;; Author:Tent

;;;欢迎交流学习,Q:305145271

;;;本版本为V2.0,之前的1.0有bug,多列相结果有误,现已修正。



;;;先把本文件后缀的“.doc”改为“.lsp”

;;;之后在CAD中:工具->加载应用程序,选中改完后缀的文件,“确定”。

;;;命令行会有提示。

;;;启动快捷键 + - /

;;;列列=列,快捷键

;;;设置小数位数,快捷键 ++





(princ "\n")

(princ "\n批量递加减文本数字命令已加载成功,启动命令:+ - / (列列=列,行行=行) ++(小数位数设置)")

(princ "\n")

;;;加载Active X功能

(vl-load-com)



;;;定义模型空间指针

(setq Mspace

(vla-get-ModelSpace

(vla-get-ActiveDocument (vlax-get-acad-object))

)

)



(defun c:+ (/ n ss1 ss1len tt str num)

(setq n (getreal "\n指定递增幅度(0): ")

num 0.0

)

(if (= n nil)

(setq n 0.0)

)

(setq ss1 (ssget ''((0 . "TEXT,MTEXT")))

ss1len (sslength ss1)

)

(repeat ss1len

(setq tt (entget (ssname ss1 num))

str (cdr (assoc 1 tt))

str (rtos (+ n (read str)) 2 3)

num (+ num 1)

;;ss1len (- ss1len 1)

tt (cdr (assoc -1 tt))

tt (vlax-ename->vla-object tt)

)

(vla-put-textstring tt str)

)

(princ "ss1''s length is :")

(princ ss1len)

(princ)

)



(defun c:- (/ n ss1 ss1len tt str num)

(setq n (getreal "\n指定递增幅度(0): ")

num 0

)

(if (= n nil)

(setq n 0.0)

)

(setq n( n -1))

(setq ss1 (ssget ''((0 . "TEXT,MTEXT")))

ss1len (sslength ss1)

)

(repeat ss1len

(setq tt (entget (ssname ss1 num))

str (cdr (assoc 1 tt))

str (rtos (+ n (read str)) 2 3)

num (+ num 1)

;;ss1len (- ss1len 1)

tt (cdr (assoc -1 tt))

tt (vlax-ename->vla-object tt)

)

(vla-put-textstring tt str)

)

(princ "ss1''s length is :")

(princ ss1len)

(princ)

)



(defun c: (/ n ss1 ss1len tt str num)

(setq n (getreal "\n指定递增幅度(1): ")

num 0

)

(if (= n nil)

(setq n 1.0)

)

(setq ss1 (ssget ''((0 . "TEXT,MTEXT")))

ss1len (sslength ss1)

)

(repeat ss1len

(setq tt (entget (ssname ss1 num))

str (cdr (assoc 1 tt))

str (rtos ( n (read str)) 2 3)

num (+ num 1)

;;ss1len (- ss1len 1)

tt (cdr (assoc -1 tt))

tt (vlax-ename->vla-object tt)

)

(vla-put-textstring tt str)

)

(princ "ss1''s length is :")

(princ ss1len)

(princ)

)



(defun c:/ (/ n ss1 ss1len tt str num)

(setq n (getreal "\n指定递增幅度(1): ")

num 0

)

(if (= n nil)

(setq n 1.0)

)

(if (= n 0)

(print "除数不能为零")

(print)

)

(setq ss1 (ssget ''((0 . "TEXT,MTEXT")))

ss1len (sslength ss1)

)

(if (/= n 0)

(repeat ss1len

(setq tt (entget (ssname ss1 num))

str (cdr (assoc 1 tt))

str (rtos (/ (read str) n) 2 3)

num (+ num 1)

;;ss1len (- ss1len 1)

tt (cdr (assoc -1 tt))

tt (vlax-ename->vla-object tt)

)

(vla-put-textstring tt str)

)

)

)



(defun c: (/ key ss1 ss2 ss3

ss1orderbx ss2orderbx ss3orderbx ss1orderby ss2orderby

ss3orderby ss1numdata ss2numdata

ss3numdata

ss1len ss2len ss3len tt1

tt2 tt3 str1 str2 str3

ss1-1x ss1-1y ss1-2x ss1-2y)



(while (= ss1 nil)

(princ "\n选择第一列(行)数据:")

(setq ss1 (ssget ''((0 . "TEXT,MTEXT"))))

(if (= ss1 nil)

(progn

(princ

"\n~~~\n~~~\nERROR:没有选择任何文本数据,请重新选择!"

)

(princ)

)

)

(if (/= ss1 nil)

(progn

(setq ss1len (sslength ss1))

(cond ((/= ss1len 1)

(setq

ss1-1x (nth 0

(cdr (assoc 10 (entget (ssname ss1 0))))

)

ss1-2x (nth 0

(cdr (assoc 10 (entget (ssname ss1 1))))

)

ss1-1y (nth 1

(cdr (assoc 10 (entget (ssname ss1 0))))

)

ss1-2y (nth 1

(cdr (assoc 10 (entget (ssname ss1 1))))

)

ss1orderbx (ssorderbyxy ss1 "x")

;根据X坐标对选择集排序得到选择集元素下标

ss1orderby (ssorderbyxy ss1 "y")

;根据Y坐标对选择集排序得到选择集元素下标

)

)

((= ss1len 1)

(setq

ss1-1x 1

ss1-2x 2

ss1-1y 1

ss1-2y 3

ss1orderbx

(ssorderbyxy ss1 "x")

;根据X坐标对选择集排序得到选择集元素下标

ss1orderby

(ssorderbyxy ss1 "y")

;根据Y坐标对选择集排序得到选择集元素下标

)

)

)

)

)

)

(while (= ss2 nil)

(princ "\n选择第二列(行)数据:")

(setq ss2 (ssget ''((0 . "TEXT,MTEXT")))

)

(if (= ss2 nil)

(progn

(princ

"\n~~~\n~~~\nERROR:没有选择任何数据!请重新选择!"

)

(princ)

)

)

(if (/= ss2 nil)

(setq ss2len (sslength ss2)

ss2orderbx (ssorderbyxy ss2 "x")

;根据Y坐标对选择集排序得到选择集元素下标

ss2orderby (ssorderbyxy ss2 "y")

;根据Y坐标对选择集排序得到选择集元素下标

)

)

(if (and (/= ss2 nil) (/= ss2len ss1len))

(progn

(princ

"\n~~~\n~~~\nERROR:数据个数不同!!!\n第一次共选择了"

)

(princ ss1len)

(princ "个数据\n请选择相同个数!!!!!!")

(princ)

(setq ss2 nil)

)

)

)



(while (= ss3 nil)

(princ "\n选择第3列(行)数据,存储前两列相乘结果:")

(setq ss3 (ssget ''((0 . "TEXT,MTEXT")))

)

(if (= ss3 nil)

(progn

(princ

"\n~~~\n~~~\nERROR:没有选择任何数据!请重新选择!"

)

(princ)

)

)

(if (/= ss3 nil)

(setq ss3len (sslength ss3)

ss3orderbx (ssorderbyxy ss3 "x")

;根据Y坐标对选择集排序得到选择集元素下标

ss3orderby (ssorderbyxy ss3 "y")

;根据Y坐标对选择集排序得到选择集元素下标

)

)

(if (and (/= ss3 nil) (/= ss3len ss1len))

(progn

(princ

"\n~~~\n~~~\nERROR:数据个数不同!!!\n第一次共选择了"

)

(princ ss1len)

(princ "个数据\n请选择相同个数!!!!!!")

(princ)

(setq ss3 nil)

)

)

)

(setq key nil)

(cond ((< (abs (- ss1-1x ss1-2x)) (abs (- ss1-1y ss1-2y)))

(setq key "Y")

)

((> (abs (- ss1-1x ss1-2x)) (abs (- ss1-1y ss1-2y)))

(setq key "X")

)

((= key nil)

(progn

(initget "X Y")

(setq

key

(getint

"\nERROR!!!自动判断属性失败!\n请手动输入需要计算的数据方向为[?竖直列(Y)/水平行(X)](默认为Y):"

)

)

(if (not key)

(setq key "Y")

)

)

)

)

(cond ((= key "Y")

(setq ss1numdata ss1orderby

ss2numdata ss2orderby

ss3numdata ss3orderby

)

)

((= key "X")

(setq ss1numdata ss1orderbx

ss2numdata ss2orderbx

ss3numdata ss3orderbx

)

)

)

(setq num 0)

(repeat ss1len

(setq tt1 (entget (ssname ss1 (nth num ss1numdata)))

str1 (read (cdr (assoc 1 tt1)))

tt2 (entget (ssname ss2 (nth num ss2numdata)))

str2 (read (cdr (assoc 1 tt2)))

tt3 (entget (ssname ss3 (nth num ss3numdata)))

str3 (rtos ( str1 str2) 2 3)

num (+ num 1)

tt3 (cdr (assoc -1 tt3))

tt3 (vlax-ename->vla-object tt3)

)

(vla-put-textstring tt3 str3)

)

)









(defun c:++ (/ ss1 ss1len tt str num numb)

(setq numb (getint "\n指定保留小数位(3) "))

(if (= numb nil)

(setq numb 3)

)

(setq ss1 (ssget ''((0 . "TEXT,MTEXT")))

ss1len (sslength ss1)

num 0

)

(repeat ss1len

(setq tt (entget (ssname ss1 num))

str (cdr (assoc 1 tt))

str (rtos (read str) 2 numb)

num (+ num 1)

tt (cdr (assoc -1 tt))

tt (vlax-ename->vla-object tt)

)

(vla-put-textstring tt str)

)

)



(defun c:sum (/ ss1 ss1len tt str num snum)

(setq ss1 (ssget ''((0 . "TEXT,MTEXT")))

ss1len (sslength ss1)

snum 0

num 0

)

(repeat ss1len

(setq tt (entget (ssname ss1 num))

str (cdr (assoc 1 tt))

str (read str)

snum (+ snum str)

num (1+ num)

)

)

(setq snum (rtos snum 2 3))

(princ "\n所选数据的总和是:")

(princ snum)

(princ)

)















;;;

;;;

;; 根据选择集X或Y坐标,对选择集排序,返回元素下标

(defun ssorderbyxy (ssdata key / xdata ydata

xdatareturn ydatareturn datareturn

num ss1 str xstr ystr

)

(setq ss1 ssdata

sslen (sslength ss1)

num 0

)

(repeat sslen

(setq str (entget (ssname ss1 num))

xstr (nth 0 (cdr (assoc 10 str)))

ystr (nth 1 (cdr (assoc 10 str)))

)

(cond ((= num 0)

(setq xdata (list xstr num)

ydata (list ystr num)

)

)

((/= num 0)

(setq xdata (append xdata (list xstr num))

ydata (append ydata (list ystr num))

)

)

)

(setq num (1+ num))

)

(setq xdata (orderbymin xdata 2)

ydata (orderbymax ydata 2)

num 1

)

(repeat sslen

(cond ((= num 1)

(setq xdatareturn (list (nth num xdata))

ydatareturn (list (nth num ydata))

)

)

((> num 1)

(setq xdatareturn (append xdatareturn (list (nth num xdata)))

ydatareturn (append ydatareturn

(list (nth num ydata))

)

)

)

)

(setq num (+ num 2))

)

(cond ((= key "x") (setq datareturn xdatareturn))

((= key "y") (setq datareturn ydatareturn))

)

datareturn

)





;;;;大->小排序

(defun orderbymax

(data increment / datareturn

datapush len1 num key str1

mark times

)

(setq len1 (length data)

num (/ len1 increment)

key 0

mark 0

times 0

)

(repeat num

(progn

(cond ((and (= datareturn nil) (= mark 0))

(setq datareturn (cdr (findlistmax data increment))

str1 (car (findlistmax data increment))

)

)

((and (= datareturn nil) (= mark 1))

(setq datareturn (cdr (findlistmax datapush increment))

str1 (car (findlistmax datapush increment))

)

)

((/= datareturn nil)

(setq

datareturn

(append datareturn (cdr (findlistmax datapush increment)))

str1 (car (findlistmax datapush increment))

)

)

)

(if (= mark 1)

(setq len1 (length datapush)

num (/ len1 increment)

key 0

)

)

(repeat (- len1 increment)

(cond

((/= key str1)

(progn

(cond ((and (= key 0) (= mark 0))

(setq datapush (list (nth key data)))

)

((and (= key 0) (= mark 1))

(setq datapush (list (nth key datapush2)))

)

((and (/= key 0) (= mark 0))

(setq

datapush

(append datapush

(list (nth key data))

)

)

)

((and (/= key 0) (= mark 1))

(setq

datapush

(append datapush (list (nth key datapush2)))

)

)

)

(setq key (+ key 1))

)

)

((= key str1)

(progn

(cond

((and (= key 0) (= mark 0))

(setq datapush (list (nth (+ key increment) data)))

)

((and (= key 0) (= mark 1))

(setq datapush (list (nth (+ key increment) datapush2)))

)

((and (/= key 0) (= mark 0))

(setq

datapush (append datapush

(list (nth (+ key increment) data))

)

)

)

((and (/= key 0) (= mark 1))

(setq

datapush (append

datapush

(list (nth (+ key increment) datapush2))

)

)

)

)

(setq key (+ key (+ increment 1)))

)

)

)

)

(setq datapush2 datapush

mark 1

)

)

)

datareturn

)





;;;;小->大排序

(defun orderbymin

(data increment / datareturn

datapush len1 num key str1

mark times

)

(setq len1 (length data)

num (/ len1 increment)

key 0

mark 0

times 0

)

(repeat num

(progn

(cond ((and (= datareturn nil) (= mark 0))

(setq datareturn (cdr (findlistmin data increment))

str1 (car (findlistmin data increment))

)

)

((and (= datareturn nil) (= mark 1))

(setq datareturn (cdr (findlistmin datapush increment))

str1 (car (findlistmin datapush increment))

)

)

((/= datareturn nil)

(setq

datareturn

(append datareturn (cdr (findlistmin datapush increment)))

str1 (car (findlistmin datapush increment))

)

)

)

(if (= mark 1)

(setq len1 (length datapush)

num (/ len1 increment)

key 0

)

)

(repeat (- len1 increment)

(cond

((/= key str1)

(progn

(cond ((and (= key 0) (= mark 0))

(setq datapush (list (nth key data)))

)

((and (= key 0) (= mark 1))

(setq datapush (list (nth key datapush2)))

)

((and (/= key 0) (= mark 0))

(setq

datapush

(append datapush

(list (nth key data))

)

)

)

((and (/= key 0) (= mark 1))

(setq

datapush

(append datapush (list (nth key datapush2)))

)

)

)

(setq key (+ key 1))

)

)

((= key str1)

(progn

(cond

((and (= key 0) (= mark 0))

(setq datapush (list (nth (+ key increment) data)))

)

((and (= key 0) (= mark 1))

(setq datapush (list (nth (+ key increment) datapush2)))

)

((and (/= key 0) (= mark 0))

(setq

datapush (append datapush

(list (nth (+ key increment) data))

)

)

)

((and (/= key 0) (= mark 1))

(setq

datapush (append

datapush

(list (nth (+ key increment) datapush2))

)

)

)

)

(setq key (+ key (+ increment 1)))

)

)

)

)

(setq datapush2 datapush

mark 1

)

)

)

datareturn

)







;;;取出表中最大值

(defun findlistmax

(data increment / datareturn len1 num var1 var2 key maxkey)

(setq len1 (length data)

num (/ len1 increment)

key 0

)

(cond ((/= num 1)

(repeat (- num 1)

(progn

(cond ((= key 0)

(setq var1 (nth key data)

maxkey 0

)

)

((/= key 0) (setq var1 (nth maxkey data)))

)

(setq var2 (nth (+ key increment) data))

(if (< var1 var2)

(setq maxkey (+ key increment))

)

(setq key (+ key increment))

)

)

(setq key maxkey)

(repeat increment

(progn

(cond ((= datareturn nil)

(setq datareturn (list (nth key data)))

)

((/= datareturn nil)

(setq datareturn

(append datareturn

(list (nth key data))

)

)

)

)

(setq key (+ key 1))

)

)

(setq datareturn (append (list maxkey) datareturn))

)

((= num 1) (setq datareturn (append (list 0) data)))

)

)



;;;取出表中最小值

(defun findlistmin

(data increment / datareturn len1 num var1 var2 key minkey)

(setq len1 (length data)

num (/ len1 increment)

key 0

)

(cond ((/= num 1)

(repeat (- num 1)

(progn

(cond ((= key 0)

(setq var1 (nth key data)

minkey 0

)

)

((/= key 0) (setq var1 (nth minkey data)))

)

(setq var2 (nth (+ key increment) data))

(if (> var1 var2)

(setq minkey (+ key increment))

)

(setq key (+ key increment))

)

)

(setq key minkey)

(repeat increment

(progn

(cond ((= datareturn nil)

(setq datareturn (list (nth minkey data)))

)

((/= datareturn nil)

(setq datareturn

(append datareturn

(list (nth key data))

)

)

)

)

(setq key (+ key 1))

)

)

(setq datareturn (append (list minkey) datareturn))

)

((= num 1) (setq datareturn (append (list 0) data)))

)

)

献花(0)
+1
(本文系新用户6542l...首藏)