大家有没有发现 GetBoundingBox 有时对spline求不出正确的结果。

Sub DB()
    Dim ent As AcadEntity
    Dim pnt As Variant
    ThisDrawing.Utility.GetEntity ent, pnt, vbCr & "选择对象："
    DrawBoundingBox ent
End Sub
Public Function DrawBoundingBox(ent As AcadEntity) As AcadLWPolyline
    Dim min, max
    ent.GetBoundingBox min, max
    Set DrawBoundingBox = Rectangle(min, max)
End Function
Public Function Rectangle(Point1, Point2) As AcadLWPolyline
    Dim vertices(0 To 7) As Double, pl As AcadLWPolyline
    vertices(0) = CDbl(Point1(0)): vertices(1) = CDbl(Point1(1))
    vertices(2) = CDbl(Point2(0)): vertices(3) = CDbl(Point1(1))
    vertices(4) = CDbl(Point2(0)): vertices(5) = CDbl(Point2(1))
    vertices(6) = CDbl(Point1(0)): vertices(7) = CDbl(Point2(1))
    Set pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(vertices)
    pl.Closed = True
    Set Rectangle = pl
End Function

u13brhascpb.jpg

;;OFFSET 2次,一进一出,可以缩少误差,但不一定正确
(defun GETBOUNDINGBOX_LAI (ENT / LL UR EN1 EN2 TYP)
  (setq TYP (cdr (assoc 0 (entget ENT))))
  (if (and (/= TYP "XLINE") (/= TYP "RAY"))
    (if        (= "SPLINE" TYP)
      (progn
        (setq EN (vlax-ename->vla-object ENT))
        ;;可能会不能OFFSET
        ;;---------------------
        (vl-catch-all-apply
          'vla-offset
          (list EN 1)
          ;;OFFSET距离还在测试
        )
        (setq EN1 (entlast))
        (vl-catch-all-apply
          'vla-offset
          (list (vlax-ename->vla-object EN1) -1)
          ;;OFFSET距离还在测试
        )
        ;;--------------------------
        (entdel EN1)
        (setq EN2 (entlast))
        (vla-getboundingbox (vlax-ename->vla-object EN2) 'LL 'UR)
        (entdel EN2)
        (mapcar 'vlax-safearray->list (list LL UR))
      )
      (progn
        (vla-getboundingbox (vlax-ename->vla-object ENT) 'LL 'UR)
        (mapcar 'vlax-safearray->list (list LL UR))
      )
    )
  )
)
(defun C:TT (/ ENT BOX)
  (setvar "OSMODE" 0)
  (setq ENT (car (entsel)))
  (setq BOX (GETBOUNDINGBOX_LAI ENT))
  (vl-cmdf ".RECTANG" (car BOX) (cadr BOX))
  (princ)
)