Topic: LM:ssboundingbox

[domenicomaria]

I'm trying to use LM:ssboundingbox

In the selection set there are lines, polylines, ellipse arcs, hatches

HATCH appears to produce incorrect results

Code - Auto/Visual Lisp: [Select]

1. (defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
2.     (repeat (setq idx (sslength sel))
3.         (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
4.         (if (and (vlax-method-applicable-p obj 'getboundingbox)
5.                  (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
6.             )
7.             (setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))
8.                   ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))
9.             )
10.         )
11.     )
12.     (if (and ls1 ls2) (list ls1 ls2))
13. )
14.  
15.  
16.  
17.  
18.  
19. (defun c:test ( / box obj sel spc )
20.     (if (and (setq sel (ssget))
21.              (setq box (LM:ssboundingbox sel))
22.         )
23.         (progn
24.             (setq spc
25.                 (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
26.                     (if (= 1 (getvar 'cvport))
27.                         'paperspace
28.                         'modelspace
29.                     )
30.                 )
31.             )
32.             (if (equal 0.0 (apply '- (mapcar 'caddr box)) 1e-6)
33.                 (progn
34.                     (setq obj
35.                         (vlax-invoke spc 'addlightweightpolyline
36.                             (apply 'append
37.                                 (mapcar '(lambda ( x ) (mapcar '(lambda ( y ) ((eval y) box)) x))
38.                                    '(
39.                                         (caar   cadar)
40.                                         (caadr  cadar)
41.                                         (caadr cadadr)
42.                                         (caar  cadadr)
43.                                     )
44.                                 )
45.                             )
46.                         )
47.                     )
48.                     (vla-put-closed obj :vlax-true)
49.                     (vla-put-elevation obj (caddar box))
50.                 )
51.                 (apply 'vlax-invoke
52.                     (vl-list* spc 'addbox
53.                         (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
54.                         (apply 'mapcar (cons '- (reverse box)))
55.                     )
56.                 )
57.             )
58.         )
59.     )
60.     (princ)
61. )
62.  
63.  

[Lee Mac]

The results are dependent upon the implementation of the ActiveX getboundingbox method, which is known to be inaccurate for hatches & splines (amongst other possible objects); to avoid this you would need to develop your own getboundingbox function by analysing the hatch boundary within the block definition and transforming accordingly to account for the position, scale, rotation, and orientation of the block reference.

[domenicomaria]

...
maybe, it might help, just ignore the hatch objects  ...
because it is probable (not sure) that the hatch is
contained in plines or lines, arcs ...
...

you would need to develop your own getboundingbox function by analysing the hatch boundary within the block definition and transforming accordingly to account for the position, scale, rotation, and orientation of the block reference.

...
For this, someone told me, to ask to a great Lisper (and not only)
that lives in London ...
...
anyway, I'll give it a try ...
...
thank you, for your great work !
...
ciao

[domenicomaria]

(defun LM:SSBoundingBox_NoHatch ( sel / idx llp ls1 ls2 obj urp )
    (repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx) ) ) ) )
        (if (and   (/= (vla-get-ObjectName obj) "AcDbHatch")
                      (vlax-method-applicable-p obj 'getboundingbox)
                      (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))
                  ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))
            )
        )
    )
    (if (and ls1 ls2) (list ls1 ls2))
)


and in any case,
avoiding to calculate the bounding box of the hatch,
the correct result is obtained

this could be acceptable,
supposing that the contour of any hatch
has to be defined from other entities

it is not the best, but something . . .