4gokay Posted January 28, 2013 Share Posted January 28, 2013 Hi, I'm Acad 2010 user. The attached file, the problem seems. I'm having trouble polyline you change the location of objects. When I move to area 1. Polyline inside area 1 the trimmed length is correct. But When I move to area 2 Polyline inside area 2 the trimmed length is incorrect. Remains a small piece of magenta polyline. Is UCS values is bigger is going on? However, when you have made a query. Acad finds 2 intersection point in area 2, incorrect. And Acad finds 1 intersection point in area 1,correct. I do not understand the problem. Thanks for your help. (All Z values to zero. All objects is polyline) trim.dwg Quote Link to comment Share on other sites More sharing options...
eldon Posted January 28, 2013 Share Posted January 28, 2013 Your problem has nothing to do with the area of the drawing that you are in, but with the method of using the Trim command. If you trim by choosing a cutting edge, you get the result in area 1. If you trim by letting AutoCAD choose the cutting edge, you get the result in area 2. Your polyline is not curve fitted and consists of a series of straight lines. What has happened is that AutoCAD chose the segment of the polyline to the right of the true intersection and used an imaginary extension of that line (the black dashed line in the picture) for the Trim. Hence your difference. Quote Link to comment Share on other sites More sharing options...
4gokay Posted January 28, 2013 Author Share Posted January 28, 2013 I'm sorry I do not understand the full solution. My english is a little poor. There are a lot drawing of polylines. I do it all. What should I do. Required lengths of polylines to me. Where should I set? Can you tell me step by step. I'm sorry. Thank you. Quote Link to comment Share on other sites More sharing options...
eldon Posted January 28, 2013 Share Posted January 28, 2013 When you use the Trim command, keep looking at the command line, which tells you what to do. First of all, it tells you to "Select cutting edges"and then "Select objects". If you press return at this point, then you are letting AutoCAD choose the cutting edges. So you must pick your cutting edge, in this case the yellow polyline. When you have finished selecting the cutting edges, you press Return to let AutoCAD know that you have finished selecting the cutting edges. Then the command line says "select object to trim......" and then you pick your magenta line. If you still do not understand, then you should look at your help files, which should be in your own language. Quote Link to comment Share on other sites More sharing options...
4gokay Posted January 29, 2013 Author Share Posted January 29, 2013 (edited) Hi eldon thanks for help. But there's a problem. I got to the intersection point. Point with VBA to read. Very points. But it shows an incorrect result. I'm not sure this is the place to VBA forum? VBA does not work why? Do you have one you know? Thanks in advance. The same two points. But the result is different from 2. Very stuck. I need to find. ///////// Sub IPNT() Dim objSS As AcadSelectionSet Dim objSS2 As AcadSelectionSet Dim Poly1 As AcadLWPolyline Dim Poly2 As AcadLWPolyline On Error Resume Next ThisDrawing.SelectionSets("TempSSet1").Delete On Error Resume Next Set objSS = ThisDrawing.SelectionSets.Add("TempSSet1") If Err Then Exit Sub MsgBox "Select Poly 1" objSS.SelectOnScreen For Each Poly1 In objSS Exit For: Next On Error Resume Next ThisDrawing.SelectionSets("TempSSet2").Delete On Error Resume Next Set objSS2 = ThisDrawing.SelectionSets.Add("TempSSet2") If Err Then Exit Sub MsgBox "Select Poly 2" objSS2.SelectOnScreen For Each Poly2 In objSS2 Exit For: Next pts = Poly1.IntersectWith(Poly2, acExtendNone) MsgBox "X= " & pts(0) & vbCr & "Y= " & pts(1), vbInformation, "Intersection Point" End Sub ///////// Give different results in the same code area 1. Area 2 also give different results. Thanks for help. trim2.dwg Edited January 30, 2013 by SLW210 Code Tags!! Quote Link to comment Share on other sites More sharing options...
4gokay Posted January 29, 2013 Author Share Posted January 29, 2013 (edited) I got to the point of intersection of two polylines. The process will be repeated many times. However, according to the VBA codes trying different UCS coordinates. Codes in area 1 is working correctly. Working in the wrong area 2. Similarly, there is also the problem trim. You can see the link below. http://www.cadtutor.net/forum/showthread.php?76891-Trimmed-Polyline-Length-Error ///////// Sub IPNT() Dim objSS As AcadSelectionSet Dim objSS2 As AcadSelectionSet Dim Poly1 As AcadLWPolyline Dim Poly2 As AcadLWPolyline On Error Resume Next ThisDrawing.SelectionSets("TempSSet1").Delete On Error Resume Next Set objSS = ThisDrawing.SelectionSets.Add("TempSSet1") If Err Then Exit Sub MsgBox "Select Poly 1" objSS.SelectOnScreen For Each Poly1 In objSS Exit For: Next On Error Resume Next ThisDrawing.SelectionSets("TempSSet2").Delete On Error Resume Next Set objSS2 = ThisDrawing.SelectionSets.Add("TempSSet2") If Err Then Exit Sub MsgBox "Select Poly 2" objSS2.SelectOnScreen For Each Poly2 In objSS2 Exit For: Next pts = Poly1.IntersectWith(Poly2, acExtendNone) MsgBox "X= " & pts(0) & vbCr & "Y= " & pts(1), vbInformation, "Intersection Point" End Sub ///////// Thanks for help. trim2.dwg Edited January 30, 2013 by SLW210 Code Tags!! Quote Link to comment Share on other sites More sharing options...
Tyke Posted January 29, 2013 Share Posted January 29, 2013 I can't see the point of the selection sets for holding a single entity, you already have two variables for your polylines and then using them with GETENTITY you can omit your selection sets with the respective code, the two loops, which are doing nothing anyway, and your first message box. You have not declared the variable 'pts' either. Try this ammended code: Sub IPNT() Dim Poly1 As AcadLWPolyline Dim Poly2 As AcadLWPolyline Dim pts As Variant Dim varPick As Variant Dim objEnt As AcadEntity ThisDrawing.Utility.GetEntity objEnt, varPick, "Select Poly 1: " If objEnt.ObjectNAme = "AcDbPolyline" then Set Poly1 = objEnt End If ThisDrawing.Utility.GetEntity objEnt, varPick, "Select Poly 1: " If objEnt.ObjectNAme = "AcDbPolyline" then Set Poly1 = objEnt End If pts = Poly1.IntersectWith(Poly2, acExtendNone) MsgBox "X= " & pts(0) & vbCr & "Y= " & pts(1), vbInformation, "Intersection Point" End Sub Quote Link to comment Share on other sites More sharing options...
4gokay Posted January 29, 2013 Author Share Posted January 29, 2013 The problem is not that you type Tyke. Of intersection is not working correctly. Thank you for your interest. Quote Link to comment Share on other sites More sharing options...
Tyke Posted January 29, 2013 Share Posted January 29, 2013 Can you please be more specific when describing your problem, I do not understand what it is. What exactly do you mean by Of intersection is not working correctly.? What is not working correctly? Describe the steps you have taken and which results are wrong. Check in your drawing the physical intersection coordinates of the two polylines and do these agree with what your program is delivering? Quote Link to comment Share on other sites More sharing options...
4gokay Posted January 30, 2013 Author Share Posted January 30, 2013 Hi Tyke. I told a more descriptive way. Waiting for assistance. Thanks in advance. Objects gives an error when I move into the area 2. Deceive me. (UCS) coordinates is making the problem be? Sub DEDECTIPONPL() Dim Poly1 As AcadLWPolyline Dim Poly2 As AcadLWPolyline Dim pts As Variant Dim varPick As Variant Dim objEnt As AcadEntity ThisDrawing.Utility.GetEntity objEnt, varPick, "Select Poly 1: " If objEnt.ObjectName = "AcDbPolyline" Then Set Poly1 = objEnt End If ThisDrawing.Utility.GetEntity objEnt, varPick, "Select Poly 2: " If objEnt.ObjectName = "AcDbPolyline" Then Set Poly2 = objEnt End If 'This Project can be dedected, 1,2 or 3 intersection point of Plines. 'This program will detect the number of point of intersection. pts = Poly1.IntersectWith(Poly2, acExtendNone) If UBound(pts) = 2 Then MsgBox "1 intersection point dedected." & vbCr & _ "X= " & pts(0) & ", " & "Y= " & pts(1) & vbCr, _ vbInformation, "Intersection Point Dedector" ElseIf UBound(pts) = 5 Then MsgBox "2 intersection point dedected." & vbCr & _ "X= " & pts(0) & ", " & "Y= " & pts(1) & vbCr & _ "X= " & pts(3) & ", " & "Y= " & pts(4), _ vbInformation, "Intersection Point Dedector" ElseIf UBound(pts) = 8 Then MsgBox "3 intersection point dedected." & vbCr & _ "X= " & pts(0) & ", " & "Y= " & pts(1) & vbCr & _ "X= " & pts(3) & ", " & "Y= " & pts(4) & vbCr & _ "X= " & pts(6) & ", " & "Y= " & pts(7), _ vbInformation, "Intersection Point Dedector" Else MsgBox "intersection point number > 3" & vbCr & "Program Limits Exceed" End If End Sub trim3.dwg Quote Link to comment Share on other sites More sharing options...
4gokay Posted January 30, 2013 Author Share Posted January 30, 2013 In connection with the subject continues. http://www.cadtutor.net/forum/showthread.php?76914-IntersectWith-not-working-correctly-VBA Quote Link to comment Share on other sites More sharing options...
Tyke Posted January 30, 2013 Share Posted January 30, 2013 Hi 4gokay, Now I see the problem and it can possibly be linked with your trim problem. I see the problem as being that you have a node on your yellow polyline that is 0.039 mm from the intersection point of the two lines. The second set of coordinates are the coordinates of the node. If I move this node so it is 0.060 mm from the intersection point then your code returns only one intersection point. It is as though there is a search radius of approximately 0.05 mm and any line segments within that radius will return an intersection point with the other polyline. What I don't understand is that in the other 'areas' which are identical to area 1 do not return 2 intersections. I copied the 'original area' and that returned 2 intersectio points. I Googled and found lots of reported problems with the IntersectWith method, so it could well be a bug in VBA. Unfortunately I see no fix for the problem. Sorry. Let's see if anybody else can help. Quote Link to comment Share on other sites More sharing options...
BlackBox Posted January 30, 2013 Share Posted January 30, 2013 Curiously... It appears as though when one copies the line work 'up' two coordinates of intersection are returned, yet 'down' only one. To test my theory, try copying Area 1 between Area 1 and Area 2 in the Y, and between the Areas and the white line work at right and two coordinates are returned. However, were you to move the resultant copy of Area 1 down in the Y, so that it now is located between the original Area 1 and the bottom of the white line work at right, then one coordinate is returned. Quote Link to comment Share on other sites More sharing options...
SLW210 Posted January 30, 2013 Share Posted January 30, 2013 I merged your threads and enclosed your Code in Code Tags. Please read the CODE POSTING GUIDELINES. In the future, if you post in the wrong forum just ask a Moderator to move it for you. Quote Link to comment Share on other sites More sharing options...
Tyke Posted January 30, 2013 Share Posted January 30, 2013 Curiously... It appears as though when one copies the line work 'up' two coordinates of intersection are returned, yet 'down' only one. To test my theory, try copying Area 1 between Area 1 and Area 2 in the Y, and between the Areas and the white line work at right and two coordinates are returned. However, were you to move the resultant copy of Area 1 down in the Y, so that it now is located between the original Area 1 and the bottom of the white line work at right, then one coordinate is returned. I can confirm what you say RenderMan. But why? That is what I don't understand. But if the OP is working only with original polylines then the problem should not arise as it seems to be just in certain copied objects. In area 1, if you draw over the two polylines with two new polylines and then delete the original ones, you still get two intersection points returned. That busts the theory above. I have no explanation! Quote Link to comment Share on other sites More sharing options...
4gokay Posted January 31, 2013 Author Share Posted January 31, 2013 Hi Tyke. I would not be the solution to the problem. But to me the right part. Examine the better. Problem coordinate systems. I think. I wonder if digits may be coming fortunes? When the problem will not come close to the coordinates 0,0,0. When away from problems and errors. Greetings. Sub DEDECTIPONPL() Dim Poly1 As AcadLWPolyline Dim Poly2 As AcadLWPolyline Dim pts As Variant Dim varPick As Variant Dim objEnt As AcadEntity ThisDrawing.Utility.GetEntity objEnt, varPick, "Select Poly 1: " If objEnt.ObjectName = "AcDbPolyline" Then Set Poly1 = objEnt End If ThisDrawing.Utility.GetEntity objEnt, varPick, "Select Poly 2: " If objEnt.ObjectName = "AcDbPolyline" Then Set Poly2 = objEnt End If 'New . New . New . New . New Dim pont(0 To 2) As Double Dim kont(0 To 2) As Double pont(0) = Poly1.Coordinates(0) pont(1) = Poly1.Coordinates(1) pont(2) = 0 kont(0) = 0 kont(1) = 0 kont(2) = 0 Poly1.Move pont, kont Poly2.Move pont, kont 'New . New . New . New . New 'This Project can be dedected, 1,2 or 3 intersection point of Plines. 'This program will detect the number of point of intersection. pts = Poly1.IntersectWith(Poly2, acExtendNone) If UBound(pts) = 2 Then MsgBox "1 intersection point dedected." & vbCr & _ "X= " & pts(0) & ", " & "Y= " & pts(1) & vbCr, _ vbInformation, "Intersection Point Dedector" ElseIf UBound(pts) = 5 Then MsgBox "2 intersection point dedected." & vbCr & _ "X= " & pts(0) & ", " & "Y= " & pts(1) & vbCr & _ "X= " & pts(3) & ", " & "Y= " & pts(4), _ vbInformation, "Intersection Point Dedector" ElseIf UBound(pts) = 8 Then MsgBox "3 intersection point dedected." & vbCr & _ "X= " & pts(0) & ", " & "Y= " & pts(1) & vbCr & _ "X= " & pts(3) & ", " & "Y= " & pts(4) & vbCr & _ "X= " & pts(6) & ", " & "Y= " & pts(7), _ vbInformation, "Intersection Point Dedector" Else MsgBox "intersection point number > 3" & vbCr & "Program Limits Exceed" End If 'New . New . New . New . New Poly1.Move kont, pont Poly2.Move kont, pont 'New . New . New . New . New End Sub 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.