Author Topic: LM:ssboundingbox  (Read 59 times)

BIGAL and 1 Guest are viewing this topic.

domenicomaria

  • Newt
  • Posts: 143
LM:ssboundingbox
« on: Today at 02:34:17 AM »
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.                     (if (= 1 (getvar 'cvport))
  26.                         'paperspace
  27.                         'modelspace
  28.                     )
  29.                 )
  30.             )
  31.             (if (equal 0.0 (apply '- (mapcar 'caddr box)) 1e-6)
  32.                 (progn
  33.                     (setq obj
  34.                         (vlax-invoke spc 'addlightweightpolyline
  35.                             (apply 'append
  36.                                 (mapcar '(lambda ( x ) (mapcar '(lambda ( y ) ((eval y) box)) x))
  37.                                    '(
  38.                                         (caar   cadar)
  39.                                         (caadr  cadar)
  40.                                         (caadr cadadr)
  41.                                         (caar  cadadr)
  42.                                     )
  43.                                 )
  44.                             )
  45.                         )
  46.                     )
  47.                     (vla-put-closed obj :vlax-true)
  48.                     (vla-put-elevation obj (caddar box))
  49.                 )
  50.                 (apply 'vlax-invoke
  51.                     (vl-list* spc 'addbox
  52.                         (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
  53.                         (apply 'mapcar (cons '- (reverse box)))
  54.                     )
  55.                 )
  56.             )
  57.         )
  58.     )
  59.     (princ)
  60. )
  61.  
  62.  

Lee Mac

  • Seagull
  • Posts: 12443
  • London, England
Re: LM:ssboundingbox
« Reply #1 on: Today at 05:20:04 AM »
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

  • Newt
  • Posts: 143
Re: LM:ssboundingbox
« Reply #2 on: Today at 06:58:29 AM »
...
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 ...
...
Quote
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

  • Newt
  • Posts: 143
Re: LM:ssboundingbox
« Reply #3 on: Today at 03:29:35 PM »
(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 . . .
« Last Edit: Today at 03:34:35 PM by domenicomaria »