frame:block-box

说明:取块定义内**图框轮廓**的包围盒（块坐标系，1:1）。n只统计可见的轴对齐 LINE（0/90/180/270）、顶点数 <8 的 LWPOLYLINE、INSERT；n先取一次盒，再只保留长度 >= 0.9 x min(宽,高) 的 LINE（贯通边线）后重算盒。n这样标题栏内部的短细线不会把盒撑大、也不会把盒缩小。n来源：private-packages/sd1t 的 sd1t:frame-p 内实体筛选思路（此处改为更严格的贯通线判据）。

用法:

 (frame:block-box blkname)

参数:1 blkname : 块名称;

返回值:list - (左下右上)；块不存在或无有效几何返回 nil

示例:

(frame:block-box "A2") => ((0.0 0.0 0.0) (594.0 420.0 0.0))

(defun frame:block-box (blkname / ents sel box p1 p2 w h m)
  "取块定义内**图框轮廓**的包围盒（块坐标系，1:1）。\n只统计可见的轴对齐 LINE（0/90/180/270）、顶点数 <8 的 LWPOLYLINE、INSERT；\n先取一次盒，再只保留长度 >= 0.9 x min(宽,高)
  的 LINE（贯通边线）后重算盒。\n这样标题栏内部的短细线不会把盒撑大、也不会把盒缩小。\n来源：private-packages/sd1t 的 sd1t:frame-p 内实体筛选思路（此处改为更严格的贯通线判据）。"
  "list - (左下 右上)；块不存在或无有效几何返回 nil"
  "(frame:block-box \"A2\")
  => ((0.0 0.0 0.0)
    (594.0 420.0 0.0))"
  (require (quote block:*))
  (require (quote pickset:*))
  (require (quote curve:*))
  (require (quote entity:*))
  (if (= (quote ename)
      (type blkname))
    (setq blkname (entity:getdxf blkname 2)))
  (if (and (p:stringp blkname)
      (not (member (strcase blkname)
          (quote ("*MODEL_SPACE"
              "*PAPER_SPACE"))))
      (not (wcmatch blkname "`**"))
      (setq ents (vl-remove-if-not (quote (lambda (x / ty a)
              (setq ty (entity:getdxf x 0))
              (and (= (vla-get-visible (e2o x))
                  :vlax-true)
                (cond ((= ty "LINE")
                    (setq a (angle (entity:getdxf x 10)
                        (entity:getdxf x 11)))
                    (or (equal a 0.0 1.0e-08)
                      (equal a (* 0.5 pi)
                        1.0e-08)
                      (equal a pi 1.0e-08)
                      (equal a (* 1.5 pi)
                        1.0e-08)))
                  ((= ty "LWPOLYLINE")
                    (< (entity:getdxf x 90)
                      8))
                  ((= ty "INSERT")
                    t)
                  (t nil)))))
          (block:ent-list blkname)))
      (<= (length ents)
        2000)
      (setq box (pickset:getbox ents 0)))
    (progn (setq p1 (car box)
        p2 (cadr box))
      (setq w (abs (- (car p2)
            (car p1)))
        h (abs (- (cadr p2)
            (cadr p1))))
      (setq m (* 0.9 (min w h)))
      (setq sel (vl-remove-if-not (quote (lambda (x / ty len)
              (setq ty (entity:getdxf x 0))
              (if (= ty "LINE")
                (progn (setq len (curve:length x))
                  (>= len m))
                t)))
          ents))
      (if sel (setq box (pickset:getbox sel 0)))
      box)
    nil))

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

frame:block-box

上传记录