求统计类似对象的长度代码修改

wzs07

目标：运行代码后，首先由用户点击单个对象作为参考图元，获取参考图元的对象类型、图层、颜色等信息，继续由用户选择对象，选择对象时仅筛选选中和选定图元对象类型、图层、颜色均完全相同的对象。再统计所有选中线条的长度，将结果转换为米为单位由用户插入到指定位置；
以下参考代码错误，请修正

2. (defun c:SelectSimilarAndSumLength (/ ent0 ent_type ent_layer ent_color sum_len pt ss ss_filtered)
   
3.   ;; 获取参考图元
   
4.   (setq ent0 (car (entsel "\n请选择参考图元: ")))
   
5.   (if ent0
   
6.     (progn
   
7.       ;; 获取参考图元信息
   
8.       (setq ent_type (cdr (assoc 0 (entget ent0)))
   
9.             ent_layer (cdr (assoc 8 (entget ent0)))
   
10.             ent_color (cdr (assoc 62 (entget ent0))))
    
11. 
    
12.       ;; 初始化选择集
    
13.       (setq ss (ssadd))
    
14. 
    
15.       ;; --- 框选相似对象 ---
    
16.       (while (setq ss_new (ssget '((0 . "LINE") (8 . ent_layer) (62 . ent_color))))
    
17.         (setq ss (ssadd (ssnamex ss_new) ss)) ;; 将新选中的对象添加到 ss
    
18.       )
    
19.       ;; --- 框选结束 ---
    
20. 
    
21.       ;; 创建空的选择集用于存放过滤后的结果
    
22.       (setq ss_filtered (ssadd))
    
23. 
    
24.       ;; 遍历选择集，筛选符合条件的对象 (包括初始选择和框选)
    
25.       (if ss
    
26.         (progn
    
27.           (setq sel_ents (ssnamex ss))
    
28.           (foreach n sel_ents
    
29.             (setq ent (entget (car n)))
    
30.             (if (and
    
31.                   (eq (cdr (assoc 0 ent)) ent_type)
    
32.                   (eq (cdr (assoc 8 ent)) ent_layer)
    
33.                   (eq (cdr (assoc 62 ent)) ent_color)
    
34.                 )
    
35.               (ssadd (car n) ss_filtered)
    
36.             )
    
37.           )
    
38.         )
    
39.       )
    
40.       
    
41.       ;; 计算总长度 (使用 ss_filtered)
    
42.       (if ss_filtered
    
43.         (progn
    
44.           (setq sum_len 0)
    
45.           (setq sel_ents (ssnamex ss_filtered))
    
46.           (foreach n sel_ents
    
47.             (setq ent (entget (car n)))
    
48.             (if (eq (cdr (assoc 0 ent)) "LINE")
    
49.               (setq sum_len (+ sum_len (distance (cdr (assoc 10 ent)) (cdr (assoc 11 ent))))))
    
50.           )
    
51.          
    
52.           ;; 将长度转换为米
    
53.           (setq sum_len (/ sum_len 1000.0))
    
54.          
    
55.           ;; 获取用户指定的位置
    
56.           (setq pt (getpoint "\n请选择文本插入点: "))
    
57.          
    
58.           ;; 插入文本
    
59.           (command "TEXT" pt "" "" (rtos sum_len 2 2))
    
60.         )
    
61.         (princ "\n未找到相似对象.")
    
62.       )
    
63.     )
    
64.     (princ "\n未选择图元.")
    
65.   )
    
66.   (princ)
    
67. )

(defun c:SelectSimilarAndSumLength (/ ent0 ent_type ent_layer ent_color sum_len pt ss ss_filtered)<br />   ;; 获取参考图元<br />   (setq ent0 (car (entsel "\n请选择参考图元: ")))<br />   (if ent0<br />     (progn<br />       ;; 获取参考图元信息<br />       (setq ent_type (cdr (assoc 0 (entget ent0)))<br />             ent_layer (cdr (assoc 8 (entget ent0)))<br />             ent_color (cdr (assoc 62 (entget ent0))))<br /> <br />       ;; 初始化选择集<br />       (setq ss (ssadd)) <br /> <br />       ;; --- 框选相似对象 ---<br />       (while (setq ss_new (ssget '((0 . "LINE") (8 . ent_layer) (62 . ent_color)))) <br />         (setq ss (ssadd (ssnamex ss_new) ss)) ;; 将新选中的对象添加到 ss<br />       )<br />       ;; --- 框选结束 ---<br /> <br />       ;; 创建空的选择集用于存放过滤后的结果<br />       (setq ss_filtered (ssadd))<br /> <br />       ;; 遍历选择集，筛选符合条件的对象 (包括初始选择和框选)<br />       (if ss<br />         (progn<br />           (setq sel_ents (ssnamex ss))<br />           (foreach n sel_ents<br />             (setq ent (entget (car n)))<br />             (if (and<br />                   (eq (cdr (assoc 0 ent)) ent_type)<br />                   (eq (cdr (assoc 8 ent)) ent_layer)<br />                   (eq (cdr (assoc 62 ent)) ent_color)<br />                 )<br />               (ssadd (car n) ss_filtered)<br />             )<br />           )<br />         )<br />       )<br />       <br />       ;; 计算总长度 (使用 ss_filtered)<br />       (if ss_filtered<br />         (progn<br />           (setq sum_len 0)<br />           (setq sel_ents (ssnamex ss_filtered))<br />           (foreach n sel_ents<br />             (setq ent (entget (car n)))<br />             (if (eq (cdr (assoc 0 ent)) "LINE")<br />               (setq sum_len (+ sum_len (distance (cdr (assoc 10 ent)) (cdr (assoc 11 ent))))))<br />           )<br />           <br />           ;; 将长度转换为米<br />           (setq sum_len (/ sum_len 1000.0))<br />           <br />           ;; 获取用户指定的位置<br />           (setq pt (getpoint "\n请选择文本插入点: "))<br />           <br />           ;; 插入文本<br />           (command "TEXT" pt "" "" (rtos sum_len 2 2))<br />         )<br />         (princ "\n未找到相似对象.")<br />       )<br />     )<br />     (princ "\n未选择图元.")<br />   )<br />   (princ)<br /> )

xyp1964

1. (defun c:tt ()
   
2.   (if (setq s0 (car (entsel "\n请选择参考图元: ")))
   
3.     (progn
   
4.       (setq la (cdr (assoc 8 (entget s0)))
   
5.             co (cdr (assoc 62 (entget s0)))
   
6.       )
   
7.       (setq ss (ssadd))
   
8.       (while (setq ss_new (ssget (list '(0 . "LINE") (cons 8 la) (cons 62 co))))
   
9.         (command "select" ss ss_new "")
   
10.         (setq ss (ssget "p"))
    
11.       )
    
12.       (if ss
    
13.         (progn
    
14.           (setq ll 0
    
15.                 i  -1
    
16.           )
    
17.           (while (setq s1 (ssname ss (setq i (1+ i))))
    
18.             (setq en (entget s1)
    
19.                   l1 (distance (cdr (assoc 10 en)) (cdr (assoc 11 en)))
    
20.                   ll (+ ll l1)
    
21.             )
    
22.           )
    
23.           (setq ll (* ll 1e-3)) ; 将长度转换为米
    
24.           (if (setq pt (getpoint "\n请选择文本插入点: ")) ; 获取用户指定的位置
    
25.             (command "TEXT" pt "" "" (rtos ll 2 2)) ; 插入文本
    
26.           )
    
27.         )
    
28.       )
    
29.     )
    
30.   )
    
31.   (princ)
    
32. )

(defun c:tt ()<br />   (if (setq s0 (car (entsel "\n请选择参考图元: ")))<br />     (progn<br />       (setq la (cdr (assoc 8 (entget s0)))<br />             co (cdr (assoc 62 (entget s0)))<br />       )<br />       (setq ss (ssadd))<br />       (while (setq ss_new (ssget (list '(0 . "LINE") (cons 8 la) (cons 62 co))))<br />         (command "select" ss ss_new "")<br />         (setq ss (ssget "p"))<br />       )<br />       (if ss<br />         (progn<br />           (setq ll 0<br />                 i  -1<br />           )<br />           (while (setq s1 (ssname ss (setq i (1+ i))))<br />             (setq en (entget s1)<br />                   l1 (distance (cdr (assoc 10 en)) (cdr (assoc 11 en)))<br />                   ll (+ ll l1)<br />             )<br />           )<br />           (setq ll (* ll 1e-3)) ; 将长度转换为米<br />           (if (setq pt (getpoint "\n请选择文本插入点: ")) ; 获取用户指定的位置<br />             (command "TEXT" pt "" "" (rtos ll 2 2)) ; 插入文本<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

wzs07

xyp1964 发表于 2024-7-15 00:41

运行后选择一条线，后显示以下

xyp1964

1. (defun c:tt (/ co i l1 la ll pt s1 ss)
   
2.   (if (and (setq s1 (car (entsel "\n请选择参考图元: ")))
   
3.            (setq la (cdr (assoc 8 (entget s1))))
   
4.            (setq co (cdr (assoc 62 (entget s1))))
   
5.            (setq ss (ssget (list '(0 . "LINE") (cons 8 la) (cons 62 co))))
   
6.       )
   
7.     (progn
   
8.       (setq ll 0
   
9.             i  -1
   
10.       )
    
11.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
12.         (setq l1 (vla-get-length (vlax-ename->vla-object s1))
    
13.               ll (+ ll l1)
    
14.         )
    
15.       )
    
16.       (if (setq pt (getpoint "\n请选择文本插入点: "))
    
17.         (command "TEXT" pt "" "" (rtos (* ll 1e-3) 2 2))
    
18.       )
    
19.     )
    
20.   )
    
21.   (princ)
    
22. )

(defun c:tt (/ co i l1 la ll pt s1 ss)<br />   (if (and (setq s1 (car (entsel "\n请选择参考图元: ")))<br />            (setq la (cdr (assoc 8 (entget s1))))<br />            (setq co (cdr (assoc 62 (entget s1))))<br />            (setq ss (ssget (list '(0 . "LINE") (cons 8 la) (cons 62 co))))<br />       )<br />     (progn<br />       (setq ll 0<br />             i  -1<br />       )<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq l1 (vla-get-length (vlax-ename->vla-object s1))<br />               ll (+ ll l1)<br />         )<br />       )<br />       (if (setq pt (getpoint "\n请选择文本插入点: "))<br />         (command "TEXT" pt "" "" (rtos (* ll 1e-3) 2 2))<br />       )<br />     )<br />   )<br />   (princ)<br /> )

wzs07

xyp1964 发表于 2024-7-15 20:08

选择参考图元后就没了