小毛草
发表于 2023-9-22 17:44:47
为什么有些文件这个文字增减用不了?有些又可以?
小毛草
发表于 2023-9-22 17:54:12
麻烦看下,什么问题?有些文件不行,有些又可以!附件这个文件就不行
kucha007
发表于 2023-9-22 20:36:27
小毛草 发表于 2023-9-22 17:54
麻烦看下,什么问题?有些文件不行,有些又可以!附件这个文件就不行
修复了,再试试看
小毛草
发表于 2023-9-23 09:23:26
本帖最后由 小毛草 于 2023-9-23 09:53 编辑
kucha007 发表于 2023-9-22 20:36
修复了,再试试看
确实已经修复,谢谢!兄弟,能让以下代码支持属性块吗?;_仿sketchup动态复制程序
(defun c:ddc (/ #error $orr p1 p2 s e cn a1 d1 ns cnn)
;___
(defun #error (s)
(command ".UNDO" "E")
(setvar "osmode" snap)
(setq *error* $orr)
)
(setq snap (getvar "osmode"))
(setvar "cmdecho" 0)
(setq $orr *error*
*error* #errormike
)_______________
(defun ttt (ss n / m)
(setq ee e
ns (ssadd)
)
(while (setq ee (entnext ee))
(setq ns (ssadd ee ns))
)
(command "erase" ns "")
(command "copy" ss "" "m" "non" p1)
(if (member (substr n (strlen n)) '("/" "*"))
(progn
(setq m 0)
(repeat(atoi n)
(setq m (1+ m))
(cond
((= "/" (substr n (strlen n)))
(command "non"(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n))))) p1 p2))
)
((= "*" (substr n (strlen n)))
(command "non"(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2))
)
)
)
)
(command "non" (setq p2 (polar p1 a1 (atof n))))
)
(command)
)
;__________________
(princ "\n动态复制程序")
(princ "\n选择要复制的物体:")
(setq s (ssget))
(setq p1 (getpoint "\n复制的起点:"))
(command "undo" "be" "line" p1 p1 "" )
(setq e (entlast) )
(command "copy" s "" "non" p1 pause)
(setqp2 (getvar "lastpoint")
a1 (angle p1 p2)
d1 (distance p1 p2)
)
(setq cn "1*")
(while cn
(ttt s cn)
(initget 128)
(princ "\n输入坐标=复制终点 输入数值=修改间距 ")
(princ "\n输入数值n并以 / 结束=间距内等分n次复制 输入数值n并以 * 结束=按间距复制n次 ")
(setq cnn (getpoint "\n请按提示输入<退出>:"))
(if(= 'LIST (type cnn))
(setq p2 cnn
a1 (angle p1 p2)
d1 (distance p1 p2)
)
(setq cn cnn)
)
)
(entdel e)
(command "undo" "e")
(princ)
)
________________________________________________
;_仿sketchup动态旋转程序
(defun c:ddr(/ p1 p2 p3 a1 cn cnn tmp e s)
;_____________________________
(defun rc (os / ns ne)
(setq ne (entlast)
ns (ssadd)
)
(command "copy" os """0,0" "0,0")
(while (setq ne (entnext ne))
(setq ns (ssadd ne ns))
)
ns
)
(defun ttt (ss n / m ee ns sn )
(setq ee e
ns (ssadd)
)
(while (setq ee (entnext ee))
(setq ns (ssadd ee ns))
)
(command "erase" ns "")
(if (member (substr n (strlen n)) '("/" "*"))
(progn
(setq m 0)
(repeat(atoi n)
(setq m (1+ m))
(setq sn(rc ss))
(cond
((= "/" (substr n (strlen n)))
(command"rotate" sn "" p1 (* m (/ a1 (atof n))))
)
((= "*" (substr n (strlen n)))
(command"rotate" sn "" p1 (* m a1))
)
)
)
)
(progn
(setq sn(rc ss))
(command"rotate" sn "" p1 (setq a1 (atof n)))
)
)
)
;_____________________________
(princ "\n动态旋转程序")
(princ "\n选择要旋转的物体:")
(setq s (ssget))
(setq p1 (getpoint "\n旋转基点"))
(setq p2 (getpoint p1 "\n旋转起点"))
(command "undo" "be" "line"p1p2 "")
(setq e (entlast))
(setq p3 (getpoint p1 "\n旋转终点"))
(setq tmp (rc s) )
(command"rotate" tmp ""p1 "r"p1p2p3)
(setq cn "1*" a1 (* 180 (/ (-(angle p1 p3)(angle p1 p2))pi)))
(while cn
(ttt s cn)
(initget 128)
(princ "\n输入坐标=旋转终点 输入数值=旋转角度 ")
(princ "\n输入数值n并以 / 结束=角度内等分n次复制 输入数值n并以 * 结束=按角度复制n次 ")
(setq cnn (getpoint "\n请按提示输入<退出>:"))
(if(= 'LIST (type cnn))
(setq p3 cnn
a1 (* 180 (/ (-(angle p1 p3)(angle p1 p2))pi))
)
(setq cn cnn)
)
)
(entdel e)
(command "undo" "e")
(princ)
)
lxl217114
发表于 2023-9-23 10:10:13
使用中发现一个小问题 比如2位数的数字xx,10、11、......17、18、19、10(此处不会进位,9后是0)
kucha007
发表于 2023-9-23 10:27:53
lxl217114 发表于 2023-9-23 10:10
使用中发现一个小问题 比如2位数的数字xx,10、11、......17、18、19、10(此处不会进位,9后是0)
因为程序名字是单字递增啦。只是后来增加了词组匹配
kucha007
发表于 2023-9-23 10:29:14
小毛草 发表于 2023-9-23 09:23
确实已经修复,谢谢!兄弟,能让以下代码支持属性块吗?
你是真不客气啊:funk:
小毛草
发表于 2023-9-23 12:10:41
kucha007 发表于 2023-9-23 10:29
你是真不客气啊
呵呵,这个功能一直改了几版都未解决,呵呵,只能看你老兄有无办法解决:lol
bai2000
发表于 2023-9-23 12:54:55
新版本,鼠标右键直接退出,要修复一下
kucha007
发表于 2023-9-24 11:17:23
bai2000 发表于 2023-9-23 12:54
新版本,鼠标右键直接退出,要修复一下
没听懂。你左右键没点到对象都会退出啊
页:
1
2
3
4
5
6
7
8
9
[10]
11
12
13
14