Author Topic: Selecting shapes based on their location "within" another object.  (Read 2747 times)

0 Members and 1 Guest are viewing this topic.

michael_h

  • Guest
Hi folks,

I'm an architectural researcher (not an architect), who's having some trouble figuring out how to write a small program. On some AutoCad stuff, I'm fairly knowledgeable, but since I'm self-taught, there are bound to be some holes in my knowledge, so no advice is too dumb.

I have a number of floorplans that I need to analyze using a program called DepthMap (it's basically a visual analysis program). This program can output data into a text file, and I have created a awk (Linux-based) program that turns the data into an AutoCad script. When run, this script "draws" the data from the DepthMap program on a new layer in the AutoCad model. Each data point is in the form of a three dimensional rectangle, where x and y give the x and y locations, and the thickness represents data from the DepthMap program. Each datapoint is colored with a particular algorithm--I've given an example below.

color 180
_rectang thickness 3.18203 0,15 0.99,15.99

I tend to have a lot of these little data points (typically >30,000). What I would like to do is to be able to draw an region on a separate layer (ideally a polygon), and then create an AutoCad program that would automatically select all of the datapoints that fall within that region. Then I would like to export properties of those datapoints to Excel (I know how to export to Excel, thankfully).

The reason I'd like to draw these regions on a separate layer is because sometimes, I need to go back and select the same data points for a different analysis, and I need to make sure that I got the same ones each time. Also, because some of these plans have a lot of repetitive, strangely shaped rooms, I would love to be able to draw a polygon region one time and copy/paste it, rather than trying to do a lot of tedious selection of data points by hand.

So, in short:

I have lots of small rectangles on layer A.
I have regions defined by polygons on layer B.
I want to write a script that exports the properties of every rectangle on layer A that falls within the limit of each polygon on layer B.

Any advice would be most welcome--even if it's just a reference to a function that might be useful. Thanks,

Michael

Fatty

  • Guest
Re: Selecting shapes based on their location "within" another object.
« Reply #1 on: April 26, 2008, 06:56:34 AM »
Try this one, it was written for one guy from
Italy two years ago, looks like it's the same task
you want to solve :)

Code: [Select]
  (defun c:WPL (/ Collector Color Coors Data Dz Elist En First_String Fn Fname I P1 P3 Ptlist Rect Second_String Ss
Thick Tmpss)
    (setq dz (getvar "dimzin"))
    (setvar "dimzin" 8)
    (command "_zoom" "_e")
    (if (setq ss (ssget "_X"
(list
  (cons -4 "<AND")
  (cons 0 "*POLYLINE,*CONTOUR")
  (cons 8 "PARTICELLA")   ; change layer of polygons here
  (cons 410 (getvar "ctab")) ; current tab only
  (cons 70 1)   ; flag (1 - for closed polyline)
  (cons -4 "AND>")
  )
)
      )

      (progn
(setq i -1)
(repeat (sslength ss)
  (setq en (ssname ss (setq i (1+ i))))
  (setq
    ptlist (vl-remove-if
     (function not)
     (mapcar
       (function (lambda (x)
   (if (= 10 (car x))
     (list (car (cdr x)) (cadr (cdr x)))
     )
   )
)
       (entget en)
       )
     )
    )

  (setq tmpss (ssget "_CP"
     ptlist
     (list
       (cons -4 "<AND")
       (cons 0 "*POLYLINE,*CONTOUR")
       (cons 8 "TESTIPARTICELLA") ; change layer of rectangles here
       (cons 90 4)   ; four vertices only
       (cons 70 1)   ; closed
       (cons -4 "AND>")
       )
     )
)

  (if tmpss
    (while
      (setq rect (ssname tmpss 0))
       (setq collector (cons rect collector))
       (ssdel rect tmpss)
       )
    )
  )
)
      (alert "No boundaries with \nthese properties")
      )
    (command "_zoom" "_p")
    (foreach itm  collector
      (setq elist (entget itm))
      (setq coors (vl-remove-if
    (function not)
    (mapcar (function (lambda (x)
(if (equal 10 (car x))
  (cdr x)
  )
)
      )
    elist
    )
    )
    )
      (setq p1 (car coors)
;;;       p2 (cadr coors)
    p3 (caddr coors)
;;;       p4 (cadddr coors)
    )
      (setq thick (cdr (assoc 40 elist))
    color (cdr (assoc 62 elist))
    )
      (setq first_string  (strcat "color " (itoa color))
    second_string (strcat "_rectang thickness "
  (rtos thick 2 5)
  " "
  (rtos (car p1) 2 2)
  ","
  (rtos (cadr p1) 2 2)
  " "
  (rtos (car p3) 2 2)
  ","
  (rtos (cadr p3) 2 2)
  )
    )

      (setq data (cons first_string data)
    data (cons second_string data))
      )
    (setq data (reverse data))
    (setq fname (strcat (getstring
  "\nEnter text file name w/o extension to save data: ")
".txt"))
    (setq fn (open (strcat (getvar "dwgprefix") fname) "w"))

    (mapcar (function (lambda (x) (write-line x fn)))
    data
    )
    (close fn)
    (alert "done")
    (setvar "dimzin" dz)
    (princ)
    )

(princ "\n  >> Start command with WPL")
(prin1)

~'J'~

Fatty

  • Guest
Re: Selecting shapes based on their location "within" another object.
« Reply #2 on: April 26, 2008, 02:21:55 PM »
.................
So, in short:

I have lots of small rectangles on layer A.
I have regions defined by polygons on layer B.
I want to write a script that exports the properties of every rectangle on layer A that falls within the limit of each polygon on layer B.

Any advice would be most welcome--even if it's just a reference to a function that might be useful. Thanks,

Michael

Sorry, Michael, i forgot about this is VBA branch
Try this instead

Code: [Select]
Option Explicit

Sub WriteLotsToFile()
     Dim oPolySset As AcadSelectionSet
     Dim oTempSset As AcadSelectionSet
     Dim ftype() As Integer
     Dim fdata() As Variant
     Dim dxfCode, dxfValue
     With ThisDrawing.SelectionSets
               While .Count > 0
                    .Item(0).Delete
               Wend
         Set oPolySset = .Add("$Polygons$")
         Set oTempSset = .Add("$Rectangles$")
     End With
     
     ReDim ftype(4) As Integer
     ReDim fdata(4) As Variant
     ftype(0) = -4: ftype(1) = 0: ftype(2) = 8: ftype(3) = 70: ftype(4) = -4
     fdata(0) = "<and": fdata(1) = "LWPOLYLINE": fdata(2) = "B": fdata(3) = 1: fdata(4) = "and>"
     dxfCode = ftype: dxfValue = fdata
 oPolySset.Select acSelectionSetAll, , , dxfCode, dxfValue
 If oPolySset.Count = 0 Then
 MsgBox "0 contours found"
 Exit Sub
 End If
 ' open text file
 Open ThisDrawing.Path & "\mydata.txt" For Output As #1 '<--change file name here
 '
 Dim oEnt As AcadEntity
 Dim oRecEnt As AcadEntity
 Dim oPline As AcadLWPolyline
 Dim oRect As AcadLWPolyline
 ReDim ftype(5)
 ReDim fdata(5)
 Dim selMod As Long
 selMod = acSelectionSetCrossingPolygon
      ftype(0) = -4: ftype(1) = 0: ftype(2) = 8: ftype(3) = 70: ftype(4) = 90: ftype(5) = -4
     fdata(0) = "<and": fdata(1) = "LWPOLYLINE": fdata(2) = "A": fdata(3) = 1: fdata(4) = 4: fdata(4) = "and>"
     dxfCode = ftype: dxfValue = fdata
For Each oEnt In oPolySset

If Not TypeOf oEnt Is AcadLWPolyline Then
MsgBox "It is not a lightweight polyline", vbExclamation, "Programm stopped"
Exit Sub
Else
Set oPline = oEnt
Dim vertPts() As Double
Dim dblElv As Double
Dim selPts As Variant
dblElv = oPline.Elevation
vertPts = oPline.Coordinates
selPts = ConvTo3dPoints(vertPts, dblElv)
'\\' An array of 3D WCS coordinates specifying the selection fence
' :ugly:Debug.Print UBound(selPts) 'debug only
selMod = acSelectionSetWindowPolygon 'acSelectionSetCrossingPolygon  '
'\\' change mode by suit
oTempSset.SelectByPolygon selMod, selPts ', dxfcode, dxfdata
oTempSset.Highlight True 'optional
'Debug.Print "Selected: " & CStr(oTempSset.Count)

For Each oRecEnt In oTempSset

If Not TypeOf oRecEnt Is AcadLWPolyline Then
MsgBox "It is not a lightweight polyline", vbExclamation, "Programm stopped"
Exit Sub
Else
Set oRect = oRecEnt
vertPts = oRect.Coordinates
Dim strFirst As String
Dim strSnd As String
strFirst = "color " & oRect.TrueColor.ColorIndex
strSnd = "_rectang thickness " & _
DSTR(oRect.ConstantWidth, acDecimal, 5) & Chr(32) & _
DSTR(vertPts(0), acDecimal, 2) & Chr(44) & _
DSTR(vertPts(1), acDecimal, 2) & Chr(32) & _
DSTR(vertPts(4), acDecimal, 2) & Chr(44) & _
DSTR(vertPts(5), acDecimal, 2)
End If
'Debug.Print strFirst
'Debug.Print strSnd
    Print #1, strFirst
    Print #1, strSnd
Next oRecEnt
oTempSset.Clear
End If
Next oEnt
Close #1

End Sub

Public Function ConvTo3dPoints(objCoors As Variant, dblElv As Double) As Variant
Dim i As Long, j As Long
Dim convPts() As Double

j = 0
For i = LBound(objCoors) To UBound(objCoors) Step 2
ReDim Preserve convPts(0 To j)
convPts(j) = objCoors(i)
ReDim Preserve convPts(0 To j + 1)
convPts(j + 1) = objCoors(i + 1)
ReDim Preserve convPts(0 To j + 2)
convPts(j + 2) = dblElv
j = j + 3

Next
ConvTo3dPoints = convPts

End Function

Function DSTR(value As Double, unit As AcUnits, prec As Long) As String
DSTR = ThisDrawing.Utility.RealToString(value, unit, prec)
End Function

~'J'~

michael_h

  • Guest
Re: Selecting shapes based on their location "within" another object.
« Reply #3 on: April 27, 2008, 12:36:56 PM »
Fatty,

Thanks, I definitely appreciate it. We're right at the end of the semester, so grading papers and such may mean that it'll take a few days to work on this, but this is very helpful!

Fatty

  • Guest
Re: Selecting shapes based on their location "within" another object.
« Reply #4 on: April 27, 2008, 02:49:14 PM »
You're welcome, Michael
Wish you to kill this semester succesfully :)

~'J'~