本帖最后由 qd001 于 2025-9-15 18:42 编辑

(defun c:TT (/ *error* ss blkName ent zVal successCount vlaObj)
  (vl-load-com)
  
  ;; 增强错误处理器
  (defun *error* (msg)
    (cond
      ((wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") nil)
      ((princ (strcat "\n[错误] " msg)))
    )
    (if (zerop (getvar 'CMDACTIVE))
      (command "_.UNDO" "_END")
    )
    (princ)
  )

  ;; 主逻辑
  (if (setq ss (ssget "_" '((0 . "INSERT") (-4 . "<NOT") (2 . "`*`*") (-4 . "NOT>"))))
    (progn
      (command "_.UNDO" "_GROUP")
      (setq successCount 0)

      ;; 阶段1：块转实体优化
      (vlax-for obj (setq vlaObj (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
        (setq ent (vlax-vla-object->ename obj)
              blkName (cdr (assoc 2 (entget ent))))
        
        (if (and (not (vl-catch-all-error-p
                      (vl-catch-all-apply 'vla-Explode (list obj))))
                 (setq ent (entlast)))
          (progn
            (command "_.UNION" "_ALL" "")
            (setq successCount (1+ successCount))
          )
        )
      )
      (vla-Delete vlaObj)

      ;; 阶段2：智能切割
      (if (> successCount 0)
        (progn
          (initget 1 "Height BoundingBox")
          (setq zVal (getkword "\n切割方式 [Height/边界框(BoundingBox)] <H>: "))
          (cond
            ((or (null zVal) (eq zVal "Height"))
             (initget 7)
             (setq zVal (getreal "\n输入切割高度(Z值): "))
             (command "_.SLICE" "_ALL" "" "_XY" (list 0 0 zVal) "_B" "_N"))
            ((eq zVal "BoundingBox")
             (command "_.SLICE" "_ALL" "" "_XY" "_MID" "" "_B" "_N"))
          )

          ;; 增强结果验证
          (if (vlax-property-available-p
                (vlax-ename->vla-object (entlast)) 'Volume)
            (princ (strcat "\n◆ 操作成功 ◆\n"
                          "切割高度: Z=" (rtos (if (numberp zVal) zVal (caddr (getvar 'EXTMAX))) 2 2) "\n"
                          "处理块数: " (itoa successCount)))
            (alert "&#9888; 切割后未生成有效实体")
          )
        )
        (alert "未找到可处理的块参照")
      )
      (command "_.UNDO" "_END")
    )
    (alert " 当前图层未选择到有效块参照")
  )
  (princ)
)


网友答:
命令: (LOAD "C:/Users/TIAN/Downloads/0.lsp") C:TT
命令: TT
◆ TT命令 - 块参照处理和切割工具
◆ 功能：将块参照炸开、合并，然后按指定方式切割
◆ 使用方法：运行命令后选择要处理的块参照
◆ 注意：只能处理非匿名块参照（名称不以*开头）
◆ 请选择要处理的块参照...
选择对象: 找到 1 个
选择对象:
◆ 开始处理块参照...
切割方式 [Height/边界框(BoundingBox)] <H>: H
输入切割高度(Z值): 1000
◆ 操作成功 ◆
切割高度: Z=1000
处理块数: 1
命令:

网友答:
线组成的块参照

网友答: 块儿内是啥东西   是点  还是线  还是面   切割要怎么切  ？  最好有上传个dwg文件

网友答: 哪位修改下能运行

网友答: 牛头不对马嘴，这个能修改的吗  除了(defun c:不用改,后面都要不得。

网友答: AI的产品那就让AI继续处理啊？

网友答: 这个干嘛的呀 咋用啊

网友答: 是这样吗 这对吗


网友答:
是这样切割成两部分,我试一试

网友答:
是这样的吗 老哥