Jump to content
abraxus

Bounding Box for Selection Set

Recommended Posts

abraxus

What would be the best way to get a bounding box for a selection set in VBA?

 

Google found a LISP routine that can do it, but it has been years since I have used LISP

 

I was thinking someone here might be easily able to convert this small LISP routine to VBA for me

 

(defun LM:SSBoundingBox ( ss / i l1 l2 ll ur )
 (repeat (setq i (sslength ss))
   (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'll 'ur)
   (setq 
     l1 (cons (vlax-safearray->list ll) l1) 
     l2 (cons (vlax-safearray->list ur) l2)
   )
  )
  (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list l1 l2))
)

Share this post


Link to post
Share on other sites
abraxus

i guess now that i think about it - it's probably not all that hard to just iterate thru each item in the selection set and track the min and max x and y coords... i guess i was just thinking that autocad would have this built in... guess not

Share this post


Link to post
Share on other sites
abraxus

ok, so yeah, i feel like an idiot for even asking this question now

 

here's the solution for those of you who wondered

 

Public Sub GetSSBoundingBox(ss As AcadSelectionSet, ptMin As Variant, ptMax As Variant)
 Dim entItem As AcadEntity
 Dim ptImin As Variant
 Dim ptImax As Variant
 Const X = 0
 Const Y = 1

 ss(0).GetBoundingBox ptMin, ptMax
 For Each entItem In ss
   entItem.GetBoundingBox ptImin, ptImax
   If ptImin(X) < ptMin(X) Then ptMin(X) = ptImin(X)
   If ptImin(Y) < ptMin(Y) Then ptMin(Y) = ptImin(Y)
   If ptImax(X) > ptMax(X) Then ptMax(X) = ptImax(X)
   If ptImax(Y) > ptMax(Y) Then ptMax(Y) = ptImax(Y)
 Next

End Sub

 

and here is how to call the function

 

Public Sub FlipTest()
 Dim ssFlip As AcadSelectionSet
 Dim pt1 As Variant
 Dim pt2 As Variant

 ' get selection set from user
 Set ssFlip = ThisDrawing.SelectionSets.Add("flip")
 ssFlip.SelectOnScreen
 
 ' get bounding box of selection set
 GetSSBoundingBox ssFlip, pt1, pt2
 
 ' draw a line from point to point
 ThisDrawing.ModelSpace.AddLine pt1, pt2
 
 ssFlip.Delete
 
End Sub

Share this post


Link to post
Share on other sites
selvamani

your code is awesome

is there any way to pass this pt1 & pt2 to plot (window) for printing

Share this post


Link to post
Share on other sites
BIGAL

selvamani the code does this look at ptimin ptimax . You can pass these to a plot window sub and say use Fit. There is lots of plot code here mainly lisp but I am sure you can find a VBA version, if thats what you want. https://forums.autodesk.com/t5/autocad-forum/plotting-in-a-vba-script/td-p/3249378

 

abraxus a check for which space your in may be a good idea. Tested in a layout and drew a line in model space. Nice code though can see lots of use like plotting.

Edited by BIGAL

Share this post


Link to post
Share on other sites
selvamani

thanks BIGAL

 

i need to find specific block which is used multiple times in a cad and and change its attributes values one by one through vba

 

any help on this please

Share this post


Link to post
Share on other sites
BIGAL

selvamani do a search here for attribute & vba lots of posted examples.

Share this post


Link to post
Share on other sites
selvamani

this points iam getting from bounding box in main sub

i dont know what is happenning i got only empty window as layout but actually points given to setplotwindow is not empty plese help on this code for your reference

 

 

 

Sub Example_SetWindowToPlot(point1 As Variant, point2 As Variant)

' This example allows the user to define an area in the current layout

' and displays a plot preview of the defined area.

'

' * Note: You have to exit the

' plot preview before the VBA example will stop and control will be returned

 

AppActivate ThisDrawing.Application.Caption

 

' Dim point1 As Variant, point2 As Variant

 

' Get first point in window

'point1 = ThisDrawing.Utility.GetPoint(, "Click the lower-left of the window to plot.")

ReDim Preserve point1(0 To 1) ' Change this to a 2D array by removing the Z position

 

' Get second point in window

'point2 = ThisDrawing.Utility.GetPoint(, "Click the upper-right of the window to plot.")

ReDim Preserve point2(0 To 1) ' Change this to a 2D array by removing the Z position

 

' Send information about window to current layout

ThisDrawing.ActiveLayout.SetWindowToPlot point1, point2

ThisDrawing.Plot.DisplayPlotPreview acFullPreview

 

' Read back window information

ThisDrawing.ActiveLayout.GetWindowToPlot point1, point2

 

MsgBox "Press any key to plot the following window:" & vbCrLf & vbCrLf & _

"Lower Left: " & point1(0) & ", " & point1(1) & vbCrLf & _

"Upper Right: " & point2(0) & ", " & point2(1)

 

' Be sure to plot a view, not some other plot style

ThisDrawing.ActiveLayout.PlotType = acWindow

 

' Send Plot To Window

ThisDrawing.ActiveLayout.ConfigName = "DWG to PDF.pc3"

ThisDrawing.Plot.DisplayPlotPreview acFullPreview

End Sub

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×