所有明经币求 列乘积 lisp
本帖最后由 wchsunshine 于 2022-3-12 22:02 编辑https://pcsdata.baidu.com/thumbnail/2d28c4f12oc44981189e2225422a3d6d?fid=3540102627-16051585-459673289179249&rt=pr&sign=FDTAER-yUdy3dSFZ0SVxtzShv1zcMqd-A4s5P2HaFEAzqP3GizfFGej6b%2BI%3D&expires=2h&chkv=0&chkbd=0&chkpc=&dp-logid=2446104033&dp-callid=0&time=1612094400&size=c1600_u1600&quality=100&vuk=-&ft=videoQQ 1615388511
本帖最后由 bssurvey 于 2021-3-11 11:50 编辑
我是用笨方法
看是不是您想要的，看可不可幫助到您，不求明經幣
(defun c:t()
(setvar "cmdecho" 0)
(prompt "请选择左侧的列")
(setq left1(ssget '((0 . "text"))))
(setq lt1(sslength left1))
(setq i 0)
(prompt "\n请选择右侧的列")
(setq right1(ssget '((0 . "text"))))
(repeat lt1
(setq rt1(sslength right1))
(setq j 0)
(setq ent(entget (ssname left1 i)))
(setq l-pt(cdr (assoc 10 ent)))
(setq txth(cdr (assoc 40 ent)))
(setq l-pt-x(car(cdr (assoc 10 ent))))
(setq l-pt-y(cadr(cdr (assoc 10 ent))))
(setq ltxt(cdr (assoc 1 ent)))
(repeat rt1
(setq rent(entget (ssname right1 j)))
(setq r-pt(cdr (assoc 10 rent)))
(setq r-pt-x(car(cdr (assoc 10 rent))))
(setq r-pt-y(cadr(cdr (assoc 10 rent))))
(setq rtxt(cdr (assoc 1 rent)))
(if (= l-pt-y r-pt-y)
(progn
(setq x1(rtos (* (atof ltxt) (atof rtxt)) 2 1))
(setq ang1(angle l-pt r-pt))
(setq di1(distance l-pt r-pt))
(setq pt1(polar r-pt ang1 (* di1 2)))
(command "text" "c" pt1 txth "0" x1)
)
)
(setq j(1+ j))
)
(setq i(1+ i))
)
(setvar "cmdecho" 1)
)
坐等大师帮忙看下，必大谢 大家帮我顶上去哈 ，急用 求 大师帮写程序必谢。 本帖最后由 vitalgg 于 2021-3-8 07:58 编辑
http://atlisp.cn/static/batch-cal.gif
http://atlisp.cn安装数学工具 应用包 vitalgg 发表于 2021-3-7 21:42
http://atlisp.cn安装数学工具 应用包
我只要单独的这个功能我不要软件包:'( 能不能给个lisp？？ wchsunshine 发表于 2021-3-9 21:18
我只要单独的这个功能我不要软件包 能不能给个lisp？？
我微信只聊天，偶尔看朋友圈，能把其它的游戏，看一看之类的删了吗？
(defun @m:sort-by-y (ss-lst)
(vl-sort ss-lst '(lambda (e1 e2)
(> (cadr (entity:getdxf e1 10))
(cadr (entity:getdxf e2 10))))))
(defun @m:column-cal (/ cal-symble number-lst ss i% res-matrix)
(initget 1 "+ - * /")
(setq cal-symble (getkword "请输入运算符 (+ - * /): "))
(setq number-lst '())
(setq i% 0)
(prompt (strcat "请选择第 " (itoa (1+ i%)) " 列:"))
(while (setq ss (ssget '((0 . "text"))))
(if number-lst
(setq number-lst
(append number-lst (list
(@m:sort-by-y (ss:to-entlist ss)))))
(setq number-lst (list(@m:sort-by-y (ss:to-entlist ss)))))
(setq i% (1+ i%))
(prompt (strcat "请选择第 " (itoa (1+ i%)) " 列:"))
)
(setq res-matrix '())
(foreach matrix number-lst
(if res-matrix
(setq res-matrix
(mapcar (read cal-symble) res-matrix
(mapcar
'(lambda (x) (atof (entity:getdxf x 1)))
matrix)))
(setq res-matrix
(mapcar '(lambda (x) (atof (entity:getdxf x 1)))
matrix)))
)
;; 写图
(mapcar '(lambda (x y)
(entity:make-text
(rtos x 2 2)
(polar (entity:getdxf y 10) 0 1000)
250 0 0.8 0 13))
res-matrix (last number-lst))
) 我这有个，不知哪位大神的，你看看
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;两列连续相乘
(defun c:*2 ( / ss1 ss2 ss3 ss1len ss2len ss3len tt1 tt2 tt3 str1 str2 str3)
(while (= ss1 nil)
(princ "\n选择第一列(行)数据：")
(setq ss1 (ssget '((0 . "TEXT,MTEXT"))))
(if (= ss1 nil)
(progn
(princ "\n~~~\n~~~\n***ERROR：没有选择任何文本数据，请重新选择!***")
(princ)
)
)
(if (/= ss1 nil)
(setq ss1len (sslength ss1))
)
)
(while (= ss2 nil)
(princ "\n选择第二列(行)数据:")
(setq ss2 (ssget '((0 . "TEXT,MTEXT")))
)
(if (= ss2 nil)
(progn
(princ "\n~~~\n~~~\n***ERROR：没有选择任何数据!请重新选择!***")
(princ)
)
)
(if (/= ss2 nil)
(setq ss2len (sslength ss2))
)
(if (and (/= ss2 nil) (/= ss2len ss1len))
(progn
(princ "\n~~~\n~~~\n***ERROR：数据个数不同!!!***\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~~~\n***ERROR：没有选择任何数据!请重新选择!***")
(princ)
)
)
(if (/= ss3 nil)
(setq ss3len (sslength ss3))
)
(if (and (/= ss3 nil) (/= ss3len ss1len))
(progn
(princ "\n~~~\n~~~\n***ERROR：数据个数不同!!!***\n***第一次共选择了" )
(princ ss1len)
(princ "个数据****\n***请选择相同个数!!!!!!*****")
(princ)
(setq ss3 nil)
)
)
)
(setq num 0)
(repeat ss1len
(setq tt1(entget (ssname ss1 num))
str1 (read (cdr (assoc 1 tt1)))
tt2(entget (ssname ss2 num))
str2 (read (cdr (assoc 1 tt2)))
tt3(entget (ssname ss3 num))
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)
)
)
bssurvey 发表于 2021-3-11 09:26
我是用笨方法
看是不是您想要的，看可不可幫助到您，不求明經幣
(defun c:t() ...
测试了，可以算乘积。希望增加乘积计算后，替换文本功能，这样可以计算后直接替换原文本，就非常好了。