wzs07 发表于 2024-7-14 15:22:00

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

目标：运行代码后，首先由用户点击单个对象作为参考图元，获取参考图元的对象类型、图层、颜色等信息，继续由用户选择对象，选择对象时仅筛选选中和选定图元对象类型、图层、颜色均完全相同的对象。再统计所有选中线条的长度，将结果转换为米为单位由用户插入到指定位置；
以下参考代码错误，请修正
(defun c:SelectSimilarAndSumLength (/ ent0 ent_type ent_layer ent_color sum_len pt ss ss_filtered)
;; 获取参考图元
(setq ent0 (car (entsel "\n请选择参考图元: ")))
(if ent0
    (progn
      ;; 获取参考图元信息
      (setq ent_type (cdr (assoc 0 (entget ent0)))
            ent_layer (cdr (assoc 8 (entget ent0)))
            ent_color (cdr (assoc 62 (entget ent0))))

      ;; 初始化选择集
      (setq ss (ssadd))

      ;; --- 框选相似对象 ---
      (while (setq ss_new (ssget '((0 . "LINE") (8 . ent_layer) (62 . ent_color))))
      (setq ss (ssadd (ssnamex ss_new) ss)) ;; 将新选中的对象添加到 ss
      )
      ;; --- 框选结束 ---

      ;; 创建空的选择集用于存放过滤后的结果
      (setq ss_filtered (ssadd))

      ;; 遍历选择集，筛选符合条件的对象 (包括初始选择和框选)
      (if ss
      (progn
          (setq sel_ents (ssnamex ss))
          (foreach n sel_ents
            (setq ent (entget (car n)))
            (if (and
                  (eq (cdr (assoc 0 ent)) ent_type)
                  (eq (cdr (assoc 8 ent)) ent_layer)
                  (eq (cdr (assoc 62 ent)) ent_color)
                )
            (ssadd (car n) ss_filtered)
            )
          )
      )
      )
      
      ;; 计算总长度 (使用 ss_filtered)
      (if ss_filtered
      (progn
          (setq sum_len 0)
          (setq sel_ents (ssnamex ss_filtered))
          (foreach n sel_ents
            (setq ent (entget (car n)))
            (if (eq (cdr (assoc 0 ent)) "LINE")
            (setq sum_len (+ sum_len (distance (cdr (assoc 10 ent)) (cdr (assoc 11 ent))))))
          )
         
          ;; 将长度转换为米
          (setq sum_len (/ sum_len 1000.0))
         
          ;; 获取用户指定的位置
          (setq pt (getpoint "\n请选择文本插入点: "))
         
          ;; 插入文本
          (command "TEXT" pt "" "" (rtos sum_len 2 2))
      )
      (princ "\n未找到相似对象.")
      )
    )
    (princ "\n未选择图元.")
)
(princ)
)



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

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

wzs07 发表于 2024-7-15 13:36:02

xyp1964 发表于 2024-7-15 00:41运行后选择一条线，后显示以下
https://s21.ax1x.com/2024/07/15/pk5hz2n.jpg

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

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

wzs07 发表于 2024-7-16 12:03:02

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


选择参考图元后就没了
页: [1]
查看完整版本: 求统计类似对象的长度代码修改