【DZ】文字增减_v1.9——支持词组匹配+钢筋符号+罗马数字

小毛草

为什么有些文件这个文字增减用不了？有些又可以？

小毛草

麻烦看下，什么问题？有些文件不行，有些又可以！附件这个文件就不行

kucha007

小毛草 发表于 2023-9-22 17:54
麻烦看下，什么问题？有些文件不行，有些又可以！附件这个文件就不行

修复了，再试试看

小毛草

kucha007 发表于 2023-9-22 20:36
修复了，再试试看

确实已经修复，谢谢！兄弟，能让以下代码支持属性块吗？

2. ;_仿sketchup动态复制程序
   
3. (defun   c:ddc (/ #error $orr p1 p2 s e cn a1 d1 ns cnn)
   
4. ;___
   
5. (defun #error (s)
   
6.     (command ".UNDO" "E")
   
7.     (setvar "osmode" snap)
   
8.     (setq *error* $orr)
   
9.   )
   
10.   (setq snap (getvar "osmode"))
    
11.   (setvar "cmdecho" 0)
    
12.   (setq $orr *error*
    
13.         *error* #errormike
    
14.   )_______________
    
15.   (defun ttt (ss n / m)
    
16.     (setq ee e
    
17.       ns (ssadd)
    
18.     )
    
19.     (while (setq ee (entnext ee))
    
20.       (setq ns (ssadd ee ns))
    
21.     )
    
22.     (command "erase" ns "")
    
23.     (command "copy" ss "" "m" "non" p1)
    
24.     (if (member (substr n (strlen n)) '("/" "*"))      
    
25.       (progn
    
26.   (setq m 0)
    
27.   (repeat  (atoi n)
    
28.     (setq m (1+ m))
    
29.     (cond
    
30.       ((= "/" (substr n (strlen n)))
    
31.        (command "non"(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n))))) p1 p2))
    
32.       )
    
33.       ((= "*" (substr n (strlen n)))
    
34.        (command "non"(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2))
    
35.       )
    
36.     )
    
37.   )
    
38.       )
    
39.       (command "non" (setq p2 (polar p1 a1 (atof n))))
    
40.     )
    
41.     (command)
    
42.   )
    
43. ;__________________
    
44.   (princ "\n动态复制程序")
    
45.   (princ "\n选择要复制的物体:")
    
46.   (setq s (ssget))
    
47.   (setq p1 (getpoint "\n复制的起点:"))
    
48.   (command "undo" "be" "line" p1 p1 "" )
    
49.   (setq e (entlast) )
    
50.   (command "copy" s "" "non" p1 pause)
    
51.   (setq  p2 (getvar "lastpoint")
    
52.   a1 (angle p1 p2)
    
53.   d1 (distance p1 p2)
    
54.   )
    
55.   (setq cn "1*")
    
56.   (while cn
    
57.     (ttt s cn)
    
58.     (initget 128)
    
59.     (princ "\n输入坐标=复制终点                         输入数值=修改间距 ")
    
60.     (princ "\n输入数值n并以 / 结束=间距内等分n次复制    输入数值n并以 * 结束=按间距复制n次 ")
    
61.     (setq cnn (getpoint "\n请按提示输入<退出>:"))
    
62.     (if  (= 'LIST (type cnn))
    
63.       (setq p2 cnn
    
64.       a1 (angle p1 p2)
    
65.       d1 (distance p1 p2)
    
66.       )
    
67.       (setq cn cnn)
    
68.     )
    
69.   )
    
70.   (entdel e)
    
71.   (command "undo" "e")
    
72.   (princ)
    
73. )
    
74. 
    
75. ________________________________________________
    
76. ;_仿sketchup动态旋转程序
    
77. (defun c:ddr(/ p1 p2 p3 a1 cn cnn tmp e s)
    
78.   ;_____________________________
    
79.   (defun rc (os / ns ne)
    
80.     (setq ne (entlast)
    
81.     ns (ssadd)
    
82.     )
    
83.     (command "copy" os ""  "0,0"   "0,0")
    
84.     (while (setq ne (entnext ne))
    
85.       (setq ns (ssadd ne ns))
    
86.     )
    
87.     ns
    
88.   )
    
89.   (defun ttt (ss n / m ee ns sn )
    
90.     (setq ee e
    
91.       ns (ssadd)
    
92.     )
    
93.     (while (setq ee (entnext ee))
    
94.       (setq ns (ssadd ee ns))
    
95.     )
    
96.     (command "erase" ns "")   
    
97.     (if (member (substr n (strlen n)) '("/" "*"))      
    
98.       (progn
    
99.   (setq m 0)
    
100.   (repeat  (atoi n)
     
101.     (setq m (1+ m))
     
102.     (setq sn(rc ss))
     
103.     (cond
     
104.       ((= "/" (substr n (strlen n)))
     
105.        (command  "rotate" sn "" p1 (* m (/ a1 (atof n))))
     
106.       )
     
107.       ((= "*" (substr n (strlen n)))
     
108.        (command  "rotate" sn "" p1 (* m a1))
     
109.       )
     
110.     )
     
111.   )
     
112.       )
     
113.       (progn
     
114.   (setq sn(rc ss))
     
115.       (command  "rotate" sn "" p1 (setq a1 (atof n)))
     
116.       )
     
117.     )
     
118.   )
     
119.   ;_____________________________
     
120.   (princ "\n动态旋转程序")
     
121.   (princ "\n选择要旋转的物体:")  
     
122.   (setq s (ssget))
     
123.   (setq p1 (getpoint "\n旋转基点"))
     
124.   (setq p2 (getpoint p1 "\n旋转起点"))
     
125.   (command "undo" "be" "line"  p1  p2 "")
     
126.   (setq e (entlast))
     
127.   (setq p3 (getpoint p1 "\n旋转终点"))
     
128.   (setq tmp (rc s) )
     
129.   (command  "rotate" tmp ""  p1 "r"  p1  p2  p3)
     
130.   (setq cn "1*" a1 (* 180 (/ (-(angle p1 p3)(angle p1 p2))pi)))  
     
131.   (while cn   
     
132.     (ttt s cn)
     
133.     (initget 128)
     
134.     (princ "\n输入坐标=旋转终点                         输入数值=旋转角度 ")
     
135.     (princ "\n输入数值n并以 / 结束=角度内等分n次复制    输入数值n并以 * 结束=按角度复制n次 ")
     
136.     (setq cnn (getpoint "\n请按提示输入<退出>:"))
     
137.     (if  (= 'LIST (type cnn))
     
138.       (setq p3 cnn
     
139.       a1 (* 180 (/ (-(angle p1 p3)(angle p1 p2))pi))
     
140.       )
     
141.       (setq cn cnn)
     
142.     )
     
143.   )
     
144.   (entdel e)
     
145.   (command "undo" "e")
     
146.   (princ)
     
147. )

;_仿sketchup动态复制程序<br /> (defun   c:ddc (/ #error $orr p1 p2 s e cn a1 d1 ns cnn)<br /> ;___<br /> (defun #error (s)<br />     (command ".UNDO" "E")<br />     (setvar "osmode" snap)<br />     (setq *error* $orr)<br />   )<br />   (setq snap (getvar "osmode"))<br />   (setvar "cmdecho" 0)<br />   (setq $orr *error*<br />         *error* #errormike<br />   )_______________<br />   (defun ttt (ss n / m)<br />     (setq ee e<br />       ns (ssadd)<br />     )<br />     (while (setq ee (entnext ee))<br />       (setq ns (ssadd ee ns))<br />     )<br />     (command "erase" ns "")<br />     (command "copy" ss "" "m" "non" p1)<br />     (if (member (substr n (strlen n)) '("/" "*"))      <br />       (progn<br />   (setq m 0)<br />   (repeat  (atoi n)<br />     (setq m (1+ m))<br />     (cond<br />       ((= "/" (substr n (strlen n)))<br />        (command "non"(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n))))) p1 p2))<br />       )<br />       ((= "*" (substr n (strlen n)))<br />        (command "non"(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2))<br />       )<br />     )<br />   )<br />       )<br />       (command "non" (setq p2 (polar p1 a1 (atof n))))<br />     )<br />     (command)<br />   )<br /> ;__________________<br />   (princ "\n动态复制程序")<br />   (princ "\n选择要复制的物体:")<br />   (setq s (ssget))<br />   (setq p1 (getpoint "\n复制的起点:"))<br />   (command "undo" "be" "line" p1 p1 "" )<br />   (setq e (entlast) )<br />   (command "copy" s "" "non" p1 pause)<br />   (setq  p2 (getvar "lastpoint")<br />   a1 (angle p1 p2)<br />   d1 (distance p1 p2)<br />   )<br />   (setq cn "1*")<br />   (while cn<br />     (ttt s cn)<br />     (initget 128)<br />     (princ "\n输入坐标=复制终点                         输入数值=修改间距 ")<br />     (princ "\n输入数值n并以 / 结束=间距内等分n次复制    输入数值n并以 * 结束=按间距复制n次 ")<br />     (setq cnn (getpoint "\n请按提示输入<退出>:"))<br />     (if  (= 'LIST (type cnn))<br />       (setq p2 cnn<br />       a1 (angle p1 p2)<br />       d1 (distance p1 p2)<br />       )<br />       (setq cn cnn)<br />     )<br />   )<br />   (entdel e)<br />   (command "undo" "e")<br />   (princ)<br /> )<br /> <br /> ________________________________________________<br /> ;_仿sketchup动态旋转程序<br /> (defun c:ddr(/ p1 p2 p3 a1 cn cnn tmp e s)<br />   ;_____________________________<br />   (defun rc (os / ns ne)<br />     (setq ne (entlast)<br />     ns (ssadd)<br />     )<br />     (command "copy" os ""  "0,0"   "0,0")<br />     (while (setq ne (entnext ne))<br />       (setq ns (ssadd ne ns))<br />     )<br />     ns<br />   )<br />   (defun ttt (ss n / m ee ns sn )<br />     (setq ee e<br />       ns (ssadd)<br />     )<br />     (while (setq ee (entnext ee))<br />       (setq ns (ssadd ee ns))<br />     )<br />     (command "erase" ns "")    <br />     (if (member (substr n (strlen n)) '("/" "*"))      <br />       (progn<br />   (setq m 0)<br />   (repeat  (atoi n)<br />     (setq m (1+ m))<br />     (setq sn(rc ss))<br />     (cond<br />       ((= "/" (substr n (strlen n)))<br />        (command  "rotate" sn "" p1 (* m (/ a1 (atof n))))<br />       )<br />       ((= "*" (substr n (strlen n)))<br />        (command  "rotate" sn "" p1 (* m a1))<br />       )<br />     )<br />   )<br />       )<br />       (progn<br />   (setq sn(rc ss))<br />       (command  "rotate" sn "" p1 (setq a1 (atof n)))<br />       )<br />     )<br />   )<br />   ;_____________________________<br />   (princ "\n动态旋转程序")<br />   (princ "\n选择要旋转的物体:")  <br />   (setq s (ssget))<br />   (setq p1 (getpoint "\n旋转基点"))<br />   (setq p2 (getpoint p1 "\n旋转起点"))<br />   (command "undo" "be" "line"  p1  p2 "")<br />   (setq e (entlast))<br />   (setq p3 (getpoint p1 "\n旋转终点"))<br />   (setq tmp (rc s) )<br />   (command  "rotate" tmp ""  p1 "r"  p1  p2  p3)<br />   (setq cn "1*" a1 (* 180 (/ (-(angle p1 p3)(angle p1 p2))pi)))  <br />   (while cn    <br />     (ttt s cn)<br />     (initget 128)<br />     (princ "\n输入坐标=旋转终点                         输入数值=旋转角度 ")<br />     (princ "\n输入数值n并以 / 结束=角度内等分n次复制    输入数值n并以 * 结束=按角度复制n次 ")<br />     (setq cnn (getpoint "\n请按提示输入<退出>:"))<br />     (if  (= 'LIST (type cnn))<br />       (setq p3 cnn<br />       a1 (* 180 (/ (-(angle p1 p3)(angle p1 p2))pi))<br />       )<br />       (setq cn cnn)<br />     )<br />   )<br />   (entdel e)<br />   (command "undo" "e")<br />   (princ)<br /> )

lxl217114

使用中发现一个小问题   比如2位数的数字xx，10、11、......17、18、19、10（此处不会进位，9后是0）

kucha007

lxl217114 发表于 2023-9-23 10:10
使用中发现一个小问题   比如2位数的数字xx，10、11、......17、18、19、10（此处不会进位，9后是0）

因为程序名字是单字递增啦。只是后来增加了词组匹配

kucha007

小毛草 发表于 2023-9-23 09:23
确实已经修复，谢谢！兄弟，能让以下代码支持属性块吗？

你是真不客气啊

小毛草

kucha007 发表于 2023-9-23 10:29
你是真不客气啊

呵呵，这个功能一直改了几版都未解决，呵呵，只能看你老兄有无办法解决

bai2000

新版本，鼠标右键直接退出，要修复一下

kucha007

bai2000 发表于 2023-9-23 12:54
新版本，鼠标右键直接退出，要修复一下

没听懂。你左右键没点到对象都会退出啊