Organic Posted January 30, 2012 Share Posted January 30, 2012 The line [color=#000080]Set[/color] acSelSet ThisDrawing.SelectionSets.Add = ("Test") throws up an error when I try to run this sample code from http://www.cad.dp.ua/stats/a_vba/acentity.php#AddEntToSS Public Sub AddEntToSS () Dim acSelSet As AcadSelectionSet Dim intCnt As Integer Dim objArray (0) As Object Dim AnyObj As AcadEntity Dim AnyPnt As Variant Set acSelSet ThisDrawing.SelectionSets.Add = ("Test") acSelSet.SelectOnScreen intCnt = acSelSet.Count MsgBox "There are" & intCnt & _ "Entities in the new Selection Set" ThisDrawing.Utility.GetEntity AnyObj, AnyPnt, _ "Pick an Entity to Add to the Selection Set:" Set objArray (0) = AnyObj acSelSet.AddItems objArray intCnt = acSelSet.Count MsgBox "Now there are" & intCnt & _ "Entities in the new Selection Set" ThisDrawing.SelectionSets.Item ("test"). Delete End Sub Can anyone tell me why that is (incompatible with 2012 API syntax?) and how I would fix it? What I am trying to do is work out (from example code I've found) how to select polylines and examine their elevation property. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted January 31, 2012 Share Posted January 31, 2012 You can use filters to select certian objects just like ssget, this bit of code example is for blocks do not have a pline Dim SS As AcadSelectionSet Dim objENT As AcadEntityDim FilterDXFCode(0) As Integer Dim FilterDXFVal(0) As Variant FilterDXFCode(0) = 0 FilterDXFVal(0) = "INSERT" 'FilterDXFCode(1) = 2 'FilterDXFVal(1) = "SCHEDTEXT" Set SS = ThisDrawing.SelectionSets.Add("pit1sel") SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal then maybe If SS.Item(Cntr).Name = BLOCK_NAME Then this may help a bit more For Each ent In ssetpick Select Case ent.EntityType Case acPolylineLight Select Case ent.Layer Case layer1 ent.Highlight (True) ent.Update 'MsgBox "You selected a poly line" '''******************************************** intVCnt = 0 varCords = 0 varVert = 0 varCord = 0 varNext = 0 intCrdCnt = 0 dblTemp = 0 dblArc = 0 dblAng = 0 dblChord = 0 dblInclAng = 0 dblRad = 0 varCords = ent.Coordinates For Each varVert In varCords intVCnt = intVCnt + 1 Next For intCrdCnt = 0 To intVCnt / 2 - 1 'For LWPoly 2 - 1 If intCrdCnt < intVCnt / 2 - 1 Then If ent.GetBulge(intCrdCnt) = 0 Then varCord = ent.Coordinate(intCrdCnt) varNext = ent.Coordinate(intCrdCnt + 1) 'computes a simple Pythagorean length dblTemp = dblTemp + Sqr((Sqr(((varCord(0) - varNext(0)) ^ 2) + _ ((varCord(1) - varNext(1)) ^ 2)) ^ 2)) ' + ((varCord(2) - varNext(2)) ^ 2)) for 3D Else 'If there is a bulge we need to get an arc length varCord = ent.Coordinate(intCrdCnt) varNext = ent.Coordinate(intCrdCnt + 1) dblChord = Sqr((Sqr(((varCord(0) - varNext(0)) ^ 2) + _ ((varCord(1) - varNext(1)) ^ 2)) ^ 2)) '+ ((varCord(2) - varNext(2)) ^ 2)) For 3D 'Bulge is the tangent of 1/4 of the included angle between 'vertices. So we reverse the process to get the included angle dblInclAng = Atn(Abs(ent.GetBulge(intCrdCnt))) * 4 dblAng = (dblInclAng / 2) - ((Atn(1) * 4) / 2) dblRad = (dblChord / 2) / (Cos(dblAng)) dblArc = dblInclAng * dblRad dblTemp = dblTemp + dblArc End If End If ''**************************************************** Next lengthPoly = lengthPoly + dblTemp End Select End Select Next Quote Link to comment Share on other sites More sharing options...
SEANT Posted January 31, 2012 Share Posted January 31, 2012 I can't test it here but, what happens if you make this change: Set acSelSet = ThisDrawing.SelectionSets.Add("Test") Quote Link to comment Share on other sites More sharing options...
fixo Posted January 31, 2012 Share Posted January 31, 2012 My 2cents http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=25&TID=49253&MID=276760#message276760 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.