画任意图元选择集的外接矩形

xitv112233

选中任意的图元，画选择集的外接矩形，这一段代码，运行后画出来的上边界异常，如何修改呢。我想要的上边框是红线

寒潮大冬瓜

guosheyang 发表于 2025-11-13 17:43
标题块儿是个剪裁块儿？

;; DrawBoxLayer创建选择集的外框(专用图层)
(defun c:DrawBoxLayer (/ ss pts p1 p2 p3 p4 p5 p6 p7 p8 p9)
  (princ "\n选择要绘制外框的对象: ")
  (setq ss (ssget))
  (if ss
    (progn
      ;; 创建或设置外框图层
      (if (not (tblsearch "LAYER" "外框"))
        (command "_.layer" "_m" "外框" "_c" "1" "" "")
        (command "_.layer" "_s" "外框" "")
      )
      
      (setq pts (xyp-9ptList ss))
      (if pts
        (progn
          (setq p1 (nth 0 pts)  ; 左下
                p2 (nth 1 pts)  ; 下中
                p3 (nth 2 pts)  ; 右下
                p4 (nth 3 pts)  ; 左中
                p5 (nth 4 pts)  ; 中心
                p6 (nth 5 pts)  ; 右中
                p7 (nth 6 pts)  ; 左上
                p8 (nth 7 pts)  ; 上中
                p9 (nth 8 pts)  ; 右上
          )
         
          ;; 绘制外框矩形
          (command "_.pline" p7 p9 p3 p1 "_close")
         
          ;; 可选：绘制中心十字线
          (command "_.line"
                   (list (car p4) (cadr p5))  ; 水平线左端点
                   (list (car p6) (cadr p5))  ; 水平线右端点
                   ""
          )
          (command "_.line"
                   (list (car p5) (cadr p2))  ; 垂直线下端点  
                   (list (car p5) (cadr p8))  ; 垂直线上端点
                   ""
          )
         
          (princ (strcat "\n已在'外框'图层绘制完成，选择集包含 "
                        (itoa (sslength ss)) " 个对象"))
        )
        (princ "\n无法计算包围盒!")
      )
    )
    (princ "\n未选择对象!")
  )
  (princ)
)

寒潮大冬瓜

DrawOutline1 - 基本外框绘制

(defun c:DrawOutline1 (/ ent p1 p3 p7 p9)
  ; 绘制基于9点坐标的矩形外框
  (if (setq ent (car (entsel "\n选择要绘制外框的实体: ")))
    (progn
      ; 获取四个角点
      (setq p1 (xyp-9Pt ent 1)  ; 左下角
            p3 (xyp-9Pt ent 3)  ; 左上角
            p7 (xyp-9Pt ent 7)  ; 右下角
            p9 (xyp-9Pt ent 9)  ; 右上角
      )
      ; 绘制矩形外框
      (command "_.pline"
               p1  ; 起点
               p7  ; 右下角
               p9  ; 右上角
               p3  ; 左上角
               "_close"  ; 闭合
      )
      (princ "\n外框绘制完成！")
    )
    (princ "\n未选择实体！")
  )
  (princ)
)

DrawOutline2 - 包含中心点的外框

;DrawOutline2绘制包含所有9个点的参考框(通过院长xyp-9Pt实体或选择集9点坐标自定义函数实现)
(defun c:DrawOutline2 (/ ent i points)
  ; 绘制包含9个关键点的参考外框
  (if (setq ent (car (entsel "\n选择要绘制外框的实体: ")))
    (progn
      ; 获取所有9个点
      (setq points '())
      (repeat 9
        (setq i (1+ (length points)))
        (setq points (cons (xyp-9Pt ent i) points))
      )
      (setq points (reverse points))
      
      ; 绘制外框
      (command "_.pline")
      (foreach pt (list (nth 0 points)  ; p1
                       (nth 6 points)  ; p7
                       (nth 8 points)  ; p9
                       (nth 2 points)  ; p3
                       )
        (command pt)
      )
      (command "_close")
      
      ; 可选：绘制中心点标记
      (command "_.point" (nth 4 points))  ; p5中心点
      
      (princ "\n外框和中心点绘制完成！")
    )
    (princ "\n未选择实体！")
  )
  (princ)
)

DrawOutline3 - 批量外框绘制

;DrawOutline3批量处理选择集的外框(通过院长xyp-9Pt实体或选择集9点坐标自定义函数实现)
(defun c:DrawOutline3 (/ ss i ent p1 p3 p7 p9)
  ; 批量绘制多个实体的外框
  (if (setq ss (ssget))
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq ent (ssname ss i))
        ; 获取四个角点
        (setq p1 (xyp-9Pt ent 1)
              p3 (xyp-9Pt ent 3)
              p7 (xyp-9Pt ent 7)
              p9 (xyp-9Pt ent 9)
        )
        ; 绘制外框
        (command "_.pline" p1 p7 p9 p3 "_close")
        (setq i (1+ i))
      )
      (princ (strcat "\n共绘制了 " (itoa i) " 个外框！"))
    )
    (princ "\n未选择任何实体！")
  )
  (princ)
)

DrawOutline4 - 在指定图层绘制外框

;DrawOutline4带图层管理的外框绘制(通过院长xyp-9Pt实体或选择集9点坐标自定义函数实现)
(defun c:DrawOutline4 (/ ent p1 p3 p7 p9 oldLayer)
  ; 在指定图层上绘制外框
  (if (setq ent (car (entsel "\n选择要绘制外框的实体: ")))
    (progn
      ; 保存当前图层
      (setq oldLayer (getvar "CLAYER"))
      
      ; 创建或切换到外框图层
      (if (not (tblsearch "LAYER" "OUTLINE"))
        (command "_.layer" "_M" "OUTLINE" "_C" "1" "" "")
        (setvar "CLAYER" "OUTLINE")
      )
      
      ; 获取四个角点
      (setq p1 (xyp-9Pt ent 1)
            p3 (xyp-9Pt ent 3)
            p7 (xyp-9Pt ent 7)
            p9 (xyp-9Pt ent 9)
      )
      
      ; 绘制外框
      (command "_.pline" p1 p7 p9 p3 "_close")
      
      ; 恢复原图层
      (setvar "CLAYER" oldLayer)
      
      (princ "\n外框在OUTLINE图层绘制完成！")
    )
    (princ "\n未选择实体！")
  )
  (princ)
)

DrawOutline5 - 带偏移距离的外框

;DrawOutline5带偏移距离的外框(通过院长xyp-9Pt实体或选择集9点坐标自定义函数实现)
(defun c:DrawOutline5 (/ ent p1 p3 p7 p9 offsetDist p1o p3o p7o p9o)
  ; 绘制带偏移距离的外框
  (if (setq ent (car (entsel "\n选择要绘制外框的实体: ")))
    (progn
      ; 获取偏移距离
      (setq offsetDist (getdist "\n输入外框偏移距离: "))
      (if (not offsetDist) (setq offsetDist 0))
      
      ; 获取四个角点
      (setq p1 (xyp-9Pt ent 1)
            p3 (xyp-9Pt ent 3)
            p7 (xyp-9Pt ent 7)
            p9 (xyp-9Pt ent 9)
      )
      
      ; 计算偏移后的点
      (setq p1o (mapcar '- p1 (list offsetDist offsetDist 0))
            p3o (mapcar '+ p3 (list 0 offsetDist 0))
            p7o (mapcar '+ p7 (list offsetDist 0 0))
            p9o (mapcar '+ p9 (list offsetDist offsetDist 0))
      )
      
      ; 绘制外框
      (command "_.pline" p1o p7o p9o p3o "_close")
      
      (princ "\n带偏移的外框绘制完成！")
    )
    (princ "\n未选择实体！")
  )
  (princ)
)

寒潮大冬瓜

寒潮大冬瓜 发表于 2025-11-13 18:14
;; DrawBoxLayer创建选择集的外框(专用图层)
(defun c:DrawBoxLayer (/ ss pts p1 p2 p3 p4 p5 p6 p7 p8 ...

院长公开的自定义函数都是经典！

;【e派】工具箱函数再揭秘及应用实例
;http://bbs.mjtd.com/forum.php?mo ... &fromuid=418631
;(出处: 明经CAD社区)
;
;【e派】工具箱函数再揭秘及应用实例
; 明经CAD社区
; 本帖最后由 xyp1964 于 2024-8-23 15:11 编辑
; xyp-9Pt实体或选择集9点坐标(xyp-9Pt ename site)
; 获取实体或选择集中的9个关键点的坐标
; 参数:
;   ename - 实体名、选择集或VLA对象
;   site - 指定要返回的点的位置（1到9）
(defun xyp-9Pt (ename site / MinPT MaxPT p1 p9 p5 p3 p7 p2 p4 p6 p8 i p1a p9a s1 x ob mid)
  ; 定义内部函数mid，用于计算两个点的中点
  ; 参数p1和p2为两个三维点，每个点用一个包含三个元素的列表表示 (x y z)
  ; 函数通过将两个点的对应坐标相加，再乘以0.5来计算中点坐标
  (defun mid (p1 p2)
    (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2))
  )
  ; 根据ename的类型处理不同的输入
  (cond
    ; 如果ename是ENAME类型（实体名）
    ((= (type ename) 'ENAME)
      ; 使用vla-getboundingbox函数获取实体的边界框
      ; 将边界框的最小点坐标存储在MinPT中，最大点坐标存储在MaxPT中
      (vla-getboundingbox (vlax-ename->vla-object ename) 'MinPT 'MaxPT)
      ; 将MinPT和MaxPT从安全数组转换为列表形式，并分别赋值给p1和p9
      (setq p1 (vlax-safearray->list MinPT)
            p9 (vlax-safearray->list MaxPT)
      )
    )
    ; 如果ename是VLA-OBJECT类型（VLA对象）
    ((= (type ename) 'VLA-OBJECT)
      ; 直接使用vla-getboundingbox函数获取VLA对象的边界框
      ; 将边界框的最小点坐标存储在MinPT中，最大点坐标存储在MaxPT中
      (vla-getboundingbox ename 'MinPT 'MaxPT)
      ; 将MinPT和MaxPT从安全数组转换为列表形式，并分别赋值给p1和p9
      (setq p1 (vlax-safearray->list MinPT)
            p9 (vlax-safearray->list MaxPT)
      )
    )
    ; 如果ename是PICKSET类型（选择集）
    ((= (type ename) 'PICKSET)
      ; 初始化变量i为 -1，用于遍历选择集中的实体
      ; p1a和p9a分别用于存储选择集中每个实体的最小点和最大点坐标
      (setq i   -1
            p1a '()
            p9a '()
      )
      ; 遍历选择集中的每个实体
      (while  (setq s1 (ssname ename (setq i (1+ i))))
        ; 将当前实体名转换为VLA对象
        (setq ob (vlax-ename->vla-object s1))
        ; 获取当前实体的边界框
        (vla-getboundingbox ob 'MinPT 'MaxPT)
        ; 将边界框的最小点和最大点从安全数组转换为列表形式
        ; 并将其分别添加到p1a和p9a列表中
        (setq p1  (vlax-safearray->list MinPT)
              p9  (vlax-safearray->list MaxPT)
              p1a (cons p1 p1a)
              p9a (cons p9 p9a)
        )
      )
      ; 计算所有实体的最小点和最大点
      ; 使用apply和mapcar函数将p1a列表中所有点的对应坐标取最小值，得到选择集的最小点p1
      ; 将p9a列表中所有点的对应坐标取最大值，得到选择集的最大点p9
      (setq p1 (apply 'mapcar (cons 'min p1a))
            p9 (apply 'mapcar (cons 'max p9a))
      )
    )
  )
  ; 计算9个关键点的坐标
  ; p5为p1和p9的中点
  (setq p5 (mid p1 p9)
        ; 根据p9和p1的x坐标大小关系确定p3的坐标
        p3 (if (< (car p9) (car p1))
               (list (car p1) (cadr p9) (caddr p1))
               (list (car p9) (cadr p1) (caddr p1))
             )
        ; 根据p9和p1的x坐标大小关系确定p7的坐标
        p7 (if (< (car p9) (car p1))
               (list (car p9) (cadr p1) (caddr p9))
               (list (car p1) (cadr p9) (caddr p9))
             )
        ; p2为p1和p3的中点
        p2 (mid p1 p3)
        ; p4为p1和p7的中点
        p4 (mid p1 p7)
        ; p6为p3和p9的中点
        p6 (mid p3 p9)
        ; p8为p7和p9的中点
        p8 (mid p7 p9)
  )
  ; 返回指定位置的点坐标
  ; 由于Lisp列表的索引从0开始，所以需要将site减1
  (nth (- site 1) (list p1 p2 p3 p4 p5 p6 p7 p8 p9))
)
; 没有最好，只有更好！e派系统(XCAD)QQ群下载：24942984

xitv112233

有文字时，显示的矩形外框就会出现如图所示问题。如果删掉所有文字就没问题

liuhe

多行文字有问题吗，改成单行文字就没问题了

guosheyang

标题块儿是个剪裁块儿？

depgfdepgf

请问下，xyp-9ptList与xyp-9Pt有什么区别？

寒潮大冬瓜

depgfdepgf 发表于 2025-11-14 07:25
请问下，xyp-9ptList与xyp-9Pt有什么区别？

都是院长在明经公布的自定义函数！xyp-9Pt是新版吧！

guosheyang

寒潮大冬瓜 发表于 2025-11-13 18:14
;; DrawBoxLayer创建选择集的外框(专用图层)
(defun c:DrawBoxLayer (/ ss pts p1 p2 p3 p4 p5 p6 p7 p8 ...

你这个对于样条线适用不？