快速统计圆孔数量
本帖最后由 流氓兔 于 2021-6-17 22:55 编辑快速统计圆孔数量，2种表达方式，模拟划线成表！
错误: 输入的字符串有缺陷 兄弟有错误 bobodod 发表于 2022-5-12 17:20
确实用不了白花了
论坛不是有不要币就可以下载的源码么，一样的功能，搜索一下就找到了
咏郡 发表于 2024-7-31 21:07
根据楼主的码改编的
不知道这种做法是否妥当，不收币吧楼主的码，收币吧楼主没得到
如真的不妥当请告 ...
大佬知道这是什么原因吗，求答复！(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)
(setq color_table ())
(princ "\n选择要进行统计的圆对象")
(setq ss (ssget (list (cons 0 "CIRCLE"))))
(setq pt (getpoint "\n选择输出基点:"))
(setq pp_int pt)
(setq si 0 tx 65 px (car pt) py (cadr pt) li '() lii 1)
(setq os (getvar "osmode") om (getvar "cmdecho"))
(command "osmode" 0 "osmode" 0 "_.ucs" "w")
(setq color_table (list))
(repeat (sslength ss)
(setq cs (ssname ss si) ce (entget cs));获取图元
(setq cp (cdr (assoc 10 ce)));获取坐标
(setq cr (cdr (assoc 40 ce)));半径
(if (setq lst (assoc cr li))
(setq ct (nth 1 lst) li (subst (list cr ct (1+ (nth 2 lst))) lst li))
(setq ct tx tx (1+ tx) li (cons (list cr ct 1) li));li =((5.26298 65 1)) 构建表 半径
)
(if (setq color_index_pair (assoc ct color_table))
(setq color_index (cdr color_index_pair))
; 如果不存在，分配一个新的颜色索引，确保不超过颜色索引范围（这里假设最大为255），并添加到 color_table 关联表中
(progn
(setq color_index (if (< (length color_table) 255) (1+ (length color_table)) 1))
(setq color_table (append color_table (list (cons ct color_index))))
)
)
(setq dimtxt_height (getvar "DIMTXT"))
(setq dimscale_factor (getvar "DIMSCALE"))
(setq actual_text_height (* dimtxt_height dimscale_factor))
(entmakex (list '(0 . "TEXT")'(100 . "AcDbEntity")
(cons 62 color_index) '(100 . "AcDbText")
(cons 10 (polar cp (/ pi 4) (+ cr 1)))
(cons 40 actual_text_height)
(cons 1 (chr ct))
(cons 8 "DIM")
))
(setq si (1+ si))
(setq color_index (if (< color_index 256) (1+ color_index) 1))
)
(foreach l li
(setq cp (list px (+ py (* lii (+ actual_text_height 7)))) );text定位点
(setq cr (nth 0 l) ct (nth 1 l) cn (nth 2 l));CR直径 CT 65 A66 B
(entmakex (list '(0 . "TEXT")'(100 . "AcDbEntity")
(cons 62 3) '(100 . "AcDbText")
(cons 8 "DIM")
(cons 10 cp)
(cons 40 actual_text_height)
(cons 1 (strcat (chr ct) ":" (itoa cn) "-%%C" (rtos (* cr 2) 2 2)))
'(50 . 0.0)
(cons 41 0.7)
'(51 . 0.0)
'(71 . 0)
'(72 . 0)
(cons 11 cp)
'(100 . "AcDbText")
'(73 . 0)))
(setq lii (1+ lii))
)
(setq height 4.)
(setq width 12.)
(setq size 3.)
(setq sc 0.5)
(setq tx1(vl-list->string(list tx)))
(setqhx (- (car(vl-string->list tx1)) 65))
(setq h hx)
(setq leng_title 1leng_row h)
(by-row-down-line pp_int (* width (+ leng_title 3)) height (+ 2 leng_row) 3 0)
(by-colu-right-line pp_int (* height (+ 1 leng_row)) width (+ leng_title 4) 3 0)
(by-x-txt-rep '("标记" "数量" "孔径" "备注") pp_int width height 1 size sc)
(setq u 0)
(foreach l li
(setq u (1+ u))
(setq pp_txt (list (car pp_int) (- (cadr pp_int) (* height u))))
(setq tb_type (nth 1 l))
(setq tx1(vl-list->string(list tx)))
(setq tb_NnO (nth 2 l))
(setq tb_diamer (nth 0 l))
(setq all (list (chr tb_type) (itoa tb_NnO)(strcat "%%C"(rtos (* tb_diamer 2) 2 2))))
(setq all1 (append all))
(by-x-txt-rep all (list (car pp_int) (cadr pp_txt)) width height 7 size sc)
)
(setvar "osmode" os)
(setvar "cmdecho" om)
(princ "\n统计完成!")
(princ)
)
;横向文字循环排列
(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)
(setq num (length lst))
(setq i -1)
(repeat num
(setq i (1+ i))
(setq txt (nth i lst))
(setq wid_now (* (+ 0.5 i) wid))
(setq pp_x (+ (car pp) wid_now))
(setq pp_y (- (cadr pp) (* 0.5 hei)))
(setq pp_txt (list pp_x pp_y))
(if(and(/= txt "")(/= txt " "))
(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)))
)
)
)
;循环画竖线
(defun by-colu-right-line(pp height colu num col wid / i pp_bottom pp_left pp_right pp_top x y)
(setq pp (list (+ (car pp) wid) (cadr pp)))
(setq i -1)
(repeat num
(setq i (1+ i))
(setq x (+ (car pp) (* i colu)))
(setq pp_top (list x (cadr pp)))
(setq pp_bottom (list x (- (cadr pp) height)))
(entmakex (list '(0 . "LINE") '(100 . "AcDbEntity")(cons 62 3) '(100 . "AcDbLine") (cons 8 "DIM") (cons 10 pp_top) (cons 11 pp_bottom)))
)
)
;循环画横线
(defun by-row-down-line(pp width row num col hei / i pp_left pp_right y)
(setq pp (list (car pp) (- (cadr pp) hei)))
(setq i -1)
(repeat num
(setq i (1+ i))
(setq y (- (cadr pp) (* i row) ))
(setq pp_left (list (car pp) y))
(setq pp_right (list (+ width (car pp)) y))
(entmakex (list '(0 . "LINE") '(100 . "AcDbEntity")(cons 62 3) '(100 . "AcDbLine") (cons 8 "DIM") (cons 10 pp_left) (cons 11 pp_right)))
)
) 我自己调整了一下，但是用原有的也会报错
664571221 发表于 2021-6-18 08:28
错误: 输入的字符串有缺陷 兄弟有错误
哪个有问题，我修改一下 谢谢! 流氓兔 分享程序!!!! 没有币啊，唉 两个LSP全是缺陷，不可用 追寻 发表于 2021-7-2 13:45
两个LSP全是缺陷，不可用
cad 2008没有问题哦，哪里有问题，提出来 你这个要是字母后面能加个编号，那就完美了。 刚开始 发表于 2022-4-16 11:56
你这个要是字母后面能加个编号，那就完美了。
都是源码了，自己加个 正需要如果加个读取固定值孔 的压铆底孔注明是压铆标准件规格就好了