快速统计圆孔数量

流氓兔

快速统计圆孔数量，2种表达方式，模拟划线成表！

664571221

错误: 输入的字符串有缺陷   兄弟有错误

liwen888888

bobodod 发表于 2022-5-12 17:20
确实用不了  白花了

论坛不是有不要币就可以下载的源码么，一样的功能，搜索一下就找到了

惜惜2

咏郡 发表于 2024-7-31 21:07
根据楼主的码改编的
不知道这种做法是否妥当，不收币吧楼主的码，收币吧楼主没得到
如真的不妥当请告 ...

大佬知道这是什么原因吗，求答复！

2. (defun c:d8(/ all all1 ce cn cp cr cs ct h height hx leng_row leng_title li lii lst om os pp_int pp_txt pt px py sc si size ss tb_diamer tb_nno tb_type tx tx1 u width color_table)
   
3.   (setq color_table ())
   
4.   (princ "\n选择要进行统计的圆对象")
   
5.   (setq ss (ssget (list (cons 0 "CIRCLE"))))
   
6.   (setq pt (getpoint "\n选择输出基点:"))
   
7.   (setq pp_int pt)
   
8.   (setq si 0 tx 65 px (car pt) py (cadr pt) li '() lii 1)
   
9.   (setq os (getvar "osmode") om (getvar "cmdecho"))
   
10.   (command "osmode" 0 "osmode" 0 "_.ucs" "w")
    
11.   (setq color_table (list))
    
12.   (repeat (sslength ss)
    
13.     (setq cs (ssname ss si) ce (entget cs));获取图元
    
14.     (setq cp (cdr (assoc 10 ce)));获取坐标
    
15.     (setq cr (cdr (assoc 40 ce)));半径
    
16.     (if (setq lst (assoc cr li))
    
17.       (setq ct (nth 1 lst) li (subst (list cr ct (1+ (nth 2 lst))) lst li))
    
18.       (setq ct tx tx (1+ tx) li (cons (list cr ct 1) li));li =((5.26298 65 1)) 构建表 半径
    
19.     )
    
20.     (if (setq color_index_pair (assoc ct color_table))
    
21.         (setq color_index (cdr color_index_pair))
    
22.         ; 如果不存在，分配一个新的颜色索引，确保不超过颜色索引范围（这里假设最大为255），并添加到 color_table 关联表中
    
23.         (progn
    
24.             (setq color_index (if (< (length color_table) 255) (1+ (length color_table)) 1))
    
25.             (setq color_table (append color_table (list (cons ct color_index))))
    
26.         )
    
27.     )
    
28.     (setq dimtxt_height (getvar "DIMTXT"))
    
29.     (setq dimscale_factor (getvar "DIMSCALE"))
    
30.     (setq actual_text_height (* dimtxt_height dimscale_factor))   
    
31.     (entmakex (list '(0 . "TEXT")'(100 . "AcDbEntity")
    
32.                 (cons 62 color_index) '(100 . "AcDbText")
    
33.                 (cons 10 (polar cp (/ pi 4) (+ cr 1)))
    
34.                 (cons 40 actual_text_height)
    
35.                 (cons 1 (chr ct))
    
36.                 (cons 8 "DIM")
    
37.                
    
38.               ))
    
39.    
    
40.     (setq si (1+ si))
    
41.     (setq color_index (if (< color_index 256) (1+ color_index) 1))
    
42.   )  
    
43.   
    
44.   
    
45.   (foreach l li
    
46.     (setq cp (list px (+ py (* lii (+ actual_text_height 7)))) );text定位点
    
47.     (setq cr (nth 0 l) ct (nth 1 l) cn (nth 2 l));CR直径 CT 65 A  66 B
    
48.     (entmakex (list '(0 . "TEXT")'(100 . "AcDbEntity")
    
49.                 (cons 62 3) '(100 . "AcDbText")
    
50.                 (cons 8 "DIM")
    
51.                 (cons 10 cp)
    
52.                 (cons 40 actual_text_height)
    
53.                 (cons 1 (strcat (chr ct) ":" (itoa cn) "-%%C" (rtos (* cr 2) 2 2)))
    
54.                 '(50 . 0.0)
    
55.                 (cons 41 0.7)
    
56.                 '(51 . 0.0)
    
57.                 '(71 . 0)
    
58.                 '(72 . 0)
    
59.                 (cons 11 cp)
    
60.                 '(100 . "AcDbText")
    
61.                 '(73 . 0)))
    
62.     (setq lii (1+ lii))
    
63.    
    
64.   )
    
65.   
    
66.   
    
67.   
    
68.   
    
69.   (setq height 4.)
    
70.   (setq width 12.)
    
71.   (setq size 3.)
    
72.   (setq sc 0.5)
    
73.   (setq tx1  (vl-list->string(list tx)))   
    
74.   (setq  hx (- (car(vl-string->list tx1)) 65))
    
75.   
    
76.   (setq h hx)
    
77.   (setq leng_title 1  leng_row h)
    
78.    (by-row-down-line pp_int (* width (+ leng_title 3)) height (+ 2 leng_row) 3 0)
    
79.   (by-colu-right-line pp_int (* height (+ 1 leng_row)) width (+ leng_title 4) 3 0)
    
80.   (by-x-txt-rep '("标记" "数量" "孔径" "备注") pp_int width height 1 size sc)
    
81.   
    
82.   
    
83.   
    
84.   
    
85.   
    
86.   
    
87.   (setq u 0)
    
88.   (foreach l li
    
89.     (setq u (1+ u))
    
90.     (setq pp_txt (list (car pp_int) (- (cadr pp_int) (* height u))))
    
91.     (setq tb_type (nth 1 l))
    
92.    
    
93.     (setq tx1  (vl-list->string(list tx)))
    
94.    
    
95.     (setq tb_NnO (nth 2 l))
    
96.     (setq tb_diamer (nth 0 l))
    
97.     (setq all (list (chr tb_type) (itoa tb_NnO)  (strcat "%%C"(rtos (* tb_diamer 2) 2 2))))
    
98.     (setq all1 (append all))
    
99.    
    
100.     (by-x-txt-rep all (list (car pp_int) (cadr pp_txt)) width height 7 size sc)  
     
101.   )
     
102.   
     
103.   
     
104.   
     
105.   
     
106.   
     
107.   (setvar "osmode" os)
     
108.   (setvar "cmdecho" om)
     
109.   (princ "\n统计完成!")
     
110.   (princ)
     
111. )
     
112. 
     
113. ;横向文字循环排列
     
114. (defun by-x-txt-rep(lst pp wid hei col size sc / hei_now i num pp_txt pp_x pp_y txt wid_now)
     
115.   (setq num (length lst))
     
116.   (setq i -1)
     
117.   (repeat num
     
118.     (setq i (1+ i))
     
119.     (setq txt (nth i lst))
     
120.     (setq wid_now (* (+ 0.5 i) wid))
     
121.     (setq pp_x (+ (car pp) wid_now))
     
122.     (setq pp_y (- (cadr pp) (* 0.5 hei)))
     
123.     (setq pp_txt (list pp_x pp_y))
     
124.     (if(and(/= txt "")(/= txt " "))
     
125.       (entmakex (list '(0 . "TEXT")'(100 . "AcDbEntity")(cons 62 3) '(100 . "AcDbText") (cons 8 "DIM") (cons 10 pp_txt) (cons 40 size) (cons 1 txt) '(50 . 0.0) (cons 41 sc) '(51 . 0.0)'(71 . 0) '(72 . 4) (cons 11 pp_txt)'(100 . "AcDbText") '(73 . 0)))
     
126.     )
     
127.    
     
128.   )
     
129. )
     
130. 
     
131. 
     
132. ;循环画竖线
     
133. (defun by-colu-right-line(pp height colu num col wid / i pp_bottom pp_left pp_right pp_top x y)
     
134.   (setq pp (list (+ (car pp) wid) (cadr pp)))
     
135.   (setq i -1)
     
136.   (repeat num
     
137.     (setq i (1+ i))
     
138.     (setq x (+ (car pp) (* i colu)))
     
139.     (setq pp_top (list x (cadr pp)))
     
140.     (setq pp_bottom (list x (- (cadr pp) height)))
     
141.     (entmakex (list '(0 . "LINE") '(100 . "AcDbEntity")(cons 62 3) '(100 . "AcDbLine") (cons 8 "DIM") (cons 10 pp_top) (cons 11 pp_bottom)))
     
142.   )
     
143. )
     
144. 
     
145. 
     
146. 
     
147. ;循环画横线
     
148. (defun by-row-down-line(pp width row num col hei / i pp_left pp_right y)
     
149.   (setq pp (list (car pp) (- (cadr pp) hei)))
     
150.   (setq i -1)
     
151.   (repeat num
     
152.     (setq i (1+ i))
     
153.     (setq y (- (cadr pp) (* i row) ))
     
154.     (setq pp_left (list (car pp) y))
     
155.     (setq pp_right (list (+ width (car pp)) y))
     
156.     (entmakex (list '(0 . "LINE") '(100 . "AcDbEntity")(cons 62 3) '(100 . "AcDbLine") (cons 8 "DIM") (cons 10 pp_left) (cons 11 pp_right)))
     
157.   )
     
158. )   我自己调整了一下，但是用原有的也会报错

(defun c:d8(/ all all1 ce cn cp cr cs ct h height hx leng_row leng_title li lii lst om os pp_int pp_txt pt px py sc si size ss tb_diamer tb_nno tb_type tx tx1 u width color_table)<br />   (setq color_table ())<br />   (princ "\n选择要进行统计的圆对象")<br />   (setq ss (ssget (list (cons 0 "CIRCLE"))))<br />   (setq pt (getpoint "\n选择输出基点:"))<br />   (setq pp_int pt)<br />   (setq si 0 tx 65 px (car pt) py (cadr pt) li '() lii 1)<br />   (setq os (getvar "osmode") om (getvar "cmdecho"))<br />   (command "osmode" 0 "osmode" 0 "_.ucs" "w")<br />   (setq color_table (list))<br />   (repeat (sslength ss)<br />     (setq cs (ssname ss si) ce (entget cs));获取图元<br />     (setq cp (cdr (assoc 10 ce)));获取坐标<br />     (setq cr (cdr (assoc 40 ce)));半径<br />     (if (setq lst (assoc cr li))<br />       (setq ct (nth 1 lst) li (subst (list cr ct (1+ (nth 2 lst))) lst li))<br />       (setq ct tx tx (1+ tx) li (cons (list cr ct 1) li));li =((5.26298 65 1)) 构建表 半径 <br />     )<br />     (if (setq color_index_pair (assoc ct color_table))<br />         (setq color_index (cdr color_index_pair))<br />         ; 如果不存在，分配一个新的颜色索引，确保不超过颜色索引范围（这里假设最大为255），并添加到 color_table 关联表中<br />         (progn<br />             (setq color_index (if (< (length color_table) 255) (1+ (length color_table)) 1))<br />             (setq color_table (append color_table (list (cons ct color_index))))<br />         )<br />     )<br />     (setq dimtxt_height (getvar "DIMTXT"))<br />     (setq dimscale_factor (getvar "DIMSCALE"))<br />     (setq actual_text_height (* dimtxt_height dimscale_factor))    <br />     (entmakex (list '(0 . "TEXT")'(100 . "AcDbEntity")<br />                 (cons 62 color_index) '(100 . "AcDbText")<br />                 (cons 10 (polar cp (/ pi 4) (+ cr 1)))<br />                 (cons 40 actual_text_height)<br />                 (cons 1 (chr ct))<br />                 (cons 8 "DIM")<br />                 <br />               ))<br />     <br />     (setq si (1+ si))<br />     (setq color_index (if (< color_index 256) (1+ color_index) 1))<br />   )  <br />   <br />   <br />   (foreach l li<br />     (setq cp (list px (+ py (* lii (+ actual_text_height 7)))) );text定位点<br />     (setq cr (nth 0 l) ct (nth 1 l) cn (nth 2 l));CR直径 CT 65 A  66 B<br />     (entmakex (list '(0 . "TEXT")'(100 . "AcDbEntity")<br />                 (cons 62 3) '(100 . "AcDbText")<br />                 (cons 8 "DIM")<br />                 (cons 10 cp)<br />                 (cons 40 actual_text_height)<br />                 (cons 1 (strcat (chr ct) ":" (itoa cn) "-%%C" (rtos (* cr 2) 2 2)))<br />                 '(50 . 0.0)<br />                 (cons 41 0.7)<br />                 '(51 . 0.0)<br />                 '(71 . 0)<br />                 '(72 . 0)<br />                 (cons 11 cp)<br />                 '(100 . "AcDbText")<br />                 '(73 . 0)))<br />     (setq lii (1+ lii))<br />     <br />   )<br />   <br />   <br />   <br />   <br />   (setq height 4.)<br />   (setq width 12.)<br />   (setq size 3.)<br />   (setq sc 0.5)<br />   (setq tx1  (vl-list->string(list tx)))   <br />   (setq  hx (- (car(vl-string->list tx1)) 65))<br />   <br />   (setq h hx)<br />   (setq leng_title 1  leng_row h)<br />    (by-row-down-line pp_int (* width (+ leng_title 3)) height (+ 2 leng_row) 3 0)<br />   (by-colu-right-line pp_int (* height (+ 1 leng_row)) width (+ leng_title 4) 3 0)<br />   (by-x-txt-rep '("标记" "数量" "孔径" "备注") pp_int width height 1 size sc)<br />   <br />   <br />   <br />   <br />   <br />   <br />   (setq u 0)<br />   (foreach l li<br />     (setq u (1+ u))<br />     (setq pp_txt (list (car pp_int) (- (cadr pp_int) (* height u))))<br />     (setq tb_type (nth 1 l))<br />     <br />     (setq tx1  (vl-list->string(list tx)))<br />     <br />     (setq tb_NnO (nth 2 l))<br />     (setq tb_diamer (nth 0 l))<br />     (setq all (list (chr tb_type) (itoa tb_NnO)  (strcat "%%C"(rtos (* tb_diamer 2) 2 2))))<br />     (setq all1 (append all))<br />     <br />     (by-x-txt-rep all (list (car pp_int) (cadr pp_txt)) width height 7 size sc)  <br />   )<br />   <br />   <br />   <br />   <br />   <br />   (setvar "osmode" os)<br />   (setvar "cmdecho" om)<br />   (princ "\n统计完成!")<br />   (princ)<br /> )<br /> <br /> ;横向文字循环排列<br /> (defun by-x-txt-rep(lst pp wid hei col size sc / hei_now i num pp_txt pp_x pp_y txt wid_now)<br />   (setq num (length lst))<br />   (setq i -1)<br />   (repeat num <br />     (setq i (1+ i))<br />     (setq txt (nth i lst))<br />     (setq wid_now (* (+ 0.5 i) wid))<br />     (setq pp_x (+ (car pp) wid_now))<br />     (setq pp_y (- (cadr pp) (* 0.5 hei)))<br />     (setq pp_txt (list pp_x pp_y))<br />     (if(and(/= txt "")(/= txt " "))<br />       (entmakex (list '(0 . "TEXT")'(100 . "AcDbEntity")(cons 62 3) '(100 . "AcDbText") (cons 8 "DIM") (cons 10 pp_txt) (cons 40 size) (cons 1 txt) '(50 . 0.0) (cons 41 sc) '(51 . 0.0)'(71 . 0) '(72 . 4) (cons 11 pp_txt)'(100 . "AcDbText") '(73 . 0)))<br />     )<br />     <br />   )<br /> )<br /> <br /> <br /> ;循环画竖线<br /> (defun by-colu-right-line(pp height colu num col wid / i pp_bottom pp_left pp_right pp_top x y)<br />   (setq pp (list (+ (car pp) wid) (cadr pp)))<br />   (setq i -1)<br />   (repeat num <br />     (setq i (1+ i))<br />     (setq x (+ (car pp) (* i colu)))<br />     (setq pp_top (list x (cadr pp)))<br />     (setq pp_bottom (list x (- (cadr pp) height)))<br />     (entmakex (list '(0 . "LINE") '(100 . "AcDbEntity")(cons 62 3) '(100 . "AcDbLine") (cons 8 "DIM") (cons 10 pp_top) (cons 11 pp_bottom)))<br />   )<br /> )<br /> <br /> <br /> <br /> ;循环画横线<br /> (defun by-row-down-line(pp width row num col hei / i pp_left pp_right y)<br />   (setq pp (list (car pp) (- (cadr pp) hei)))<br />   (setq i -1)<br />   (repeat num <br />     (setq i (1+ i))<br />     (setq y (- (cadr pp) (* i row) ))<br />     (setq pp_left (list (car pp) y))<br />     (setq pp_right (list (+ width (car pp)) y))<br />     (entmakex (list '(0 . "LINE") '(100 . "AcDbEntity")(cons 62 3) '(100 . "AcDbLine") (cons 8 "DIM") (cons 10 pp_left) (cons 11 pp_right)))<br />   )<br /> )   我自己调整了一下，但是用原有的也会报错

流氓兔

664571221 发表于 2021-6-18 08:28
错误: 输入的字符串有缺陷   兄弟有错误

哪个有问题，我修改一下

yoyoho

谢谢! 流氓兔 分享程序!!!!

gowww

没有币啊，唉

追寻

两个LSP全是缺陷，不可用

流氓兔

追寻 发表于 2021-7-2 13:45
两个LSP全是缺陷，不可用

cad 2008没有问题哦，哪里有问题，提出来

刚开始

你这个要是字母后面能加个编号，那就完美了。

流氓兔

刚开始 发表于 2022-4-16 11:56
你这个要是字母后面能加个编号，那就完美了。

都是源码了，自己加个

bobodod

正需要  如果加个  读取固定值孔 的压铆底孔注明是  压铆标准件规格就好了