iTijn Posted January 19, 2010 Share Posted January 19, 2010 Hi all, I would like to fillet/chamfer a big selection of PolyLines with a macro in VBA. Though i cannot find a 'Method' to do this. Start of Code would look similar to this: Sub CableChamfer() '[color="green"]Chamfer selected poly lines that are on the cable group layers[/color] Dim PLineSelection As AcadSelectionSet Set PLineSelection = DataS.GetCurrentSelectionPLINES() Dim PolyLine As AcadPolyline Dim Handle As String For Each PolyLine In PLineSelection [color="Green"]'Conditional filtering will be added here[/color] Set PolyLine = ChamferPoly(3) Next PolyLine End Sub '[color="Green"]____________________________________________________________[/color] Function ChamferPoly(Distance As Double) As AcPolylineType [color="Green"]'How do I chamfer a polyline from VBA???[/color] End Function Help file or object explorer doesn't give any answers. Time to ask the experts @ CADTutor PS. I know that VBA is going to be obsolete. Though the whole project is written in VBA. Quote Link to comment Share on other sites More sharing options...
SEANT Posted January 19, 2010 Share Posted January 19, 2010 As you already mentioned, there is no direct method call for Chamfer. The process will have to be recreated in VBA, which will likely require a call to the AddVertex, as well as some math to determine where the new vertex pair should be located. A Fillet procedure will also necessitate a SetBulge call. Quote Link to comment Share on other sites More sharing options...
iTijn Posted January 20, 2010 Author Share Posted January 20, 2010 OK That is a real shame. I will put it on my list of modules to write. In the mean time, I'm thinking of a work around: To go through the command line interface. I'm sure I've seen a trick to 'pick' an object by it's HANDLE in the Command line interface. though I can't find this nifty trick anymore. PS. I'm planning to migrate to .NET in the future. Does anybody know by chance if the Chamfer/Fillet function is integrated in the .NET API? (might encourage me to migrate sooner.) Regards, iTijn Quote Link to comment Share on other sites More sharing options...
ollie Posted January 21, 2010 Share Posted January 21, 2010 Hi I think what you are looking for is dim i as int For Each polyline in plineSset for i =0 i<polyline.getcoordinates.length polyline.setBulge(i, radius) next next polyline I use 2010 so I can't test it but the setBulge is definitely the method you are looking for Similarly if you wrote it in lisp you could use its conterpart vla-setBulge Hope that helps, Ollie Quote Link to comment Share on other sites More sharing options...
ollie Posted January 21, 2010 Share Posted January 21, 2010 Hi again (defun c:fire() (setq ent(vlax-ename->vla-object(car(entsel)))) (setq rad(getreal "enter radius")) (setq count(/ (length (vlax-safearray->list (variant-value (vla-get-coordinates ent)))) 2)) (setq cntr -1) (while(<(setq cntr (1+ cntr)) count) (vla-setbulge ent cntr rad) ) ) Above is an example using lisp. It may help Ollie Quote Link to comment Share on other sites More sharing options...
zimbo Posted May 26, 2020 Share Posted May 26, 2020 On 20/01/2010 at 17:24, iTijn said: OK That is a real shame. I will put it on my list of modules to write. (...) Hi, this is an old topic but here is a sub and a function in case it helps anyone. Sub UtilAddChamfer(plineObj As AcadLWPolyline, existingVertexIndex As Integer, chamfer_dimension As Double) 'coordinates of vertex where the chamfer is to be created v0 = existingVertexIndex 'vertex index x0 = plineObj.Coordinate(v0)(0) y0 = plineObj.Coordinate(v0)(1) 'coordinates of next vertex v1 = v0 + 1 x1 = plineObj.Coordinate(v1)(0) y1 = plineObj.Coordinate(v1)(1) 'line between v0 and v1 m1 = (y1 - y0) / (x1 - x0) 'point on line vertex_0 to vertex_1 at distance chamfer_dimension from x0, y0 arr_result = UtilCircleLineIntersection(Array(m1, x0, y0), chamfer_dimension) x1a = arr_result(0)(0) y1a = arr_result(0)(1) x1b = arr_result(1)(0) y1b = arr_result(1)(1) 'choose nearest to vertex_1 as the new vertex Dim newPoint(0 To 1) As Double If (y1 - y1b) ^ 2 + (x1 - x1b) ^ 2 < (y1 - y1a) ^ 2 + (x1 - x1a) ^ 2 Then newPoint(0) = x1b: newPoint(1) = y1b Else newPoint(0) = x1a: newPoint(1) = y1a End If 'add vertex plineObj.AddVertex v0 + 1, newPoint 'coordinates of previous vertex v1 = v0 - 1 x1 = plineObj.Coordinate(v1)(0) y1 = plineObj.Coordinate(v1)(1) 'line between v0 and v1 m1 = (y1 - y0) / (x1 - x0) 'point on line vertex_0 to vertex_1 at distance chamfer_dimension from x0, y0 arr_result = UtilCircleLineIntersection(Array(m1, x0, y0), chamfer_dimension) x1a = arr_result(0)(0) y1a = arr_result(0)(1) x1b = arr_result(1)(0) y1b = arr_result(1)(1) 'choose nearest to vertex_1 as the new vertex If (y1 - y1b) ^ 2 + (x1 - x1b) ^ 2 < (y1 - y1a) ^ 2 + (x1 - x1a) ^ 2 Then newPoint(0) = x1b: newPoint(1) = y1b Else newPoint(0) = x1a: newPoint(1) = y1a End If 'modify existing vertex plineObj.Coordinate(v0) = newPoint ThisDrawing.Regen acActiveViewport End Sub Function UtilCircleLineIntersection(line0, radius) 'returns 2 points on line0 at distance radius from x0, y0 m0 = line0(0) 'slope x0 = line0(1) 'x of point on the line y0 = line0(2) 'y of point on the line '================================== 'sage code used to obtain solutions ''var('x y') ''(x, y) ''eq1 = y==m0*(x-x0)+y0 ''eq2 = (y-y0)^2+(x-x0)^2==radius^2 ''solve([eq1,eq2],x,y) '================================== 'solution 1 x1a = ((m0 ^ 2 + 1) * x0 - Sqr(m0 ^ 2 + 1) * radius) / (m0 ^ 2 + 1) y1a = -(Sqr(m0 ^ 2 + 1) * m0 * radius - (m0 ^ 2 + 1) * y0) / (m0 ^ 2 + 1) 'solution 2 x1b = ((m0 ^ 2 + 1) * x0 + Sqr(m0 ^ 2 + 1) * radius) / (m0 ^ 2 + 1) y1b = (Sqr(m0 ^ 2 + 1) * m0 * radius + (m0 ^ 2 + 1) * y0) / (m0 ^ 2 + 1) Dim result(0 To 1) result(0) = Array(x1a, y1a) 'first solution result(1) = Array(x1b, y1b) 'second solution UtilCircleLineIntersection = result End Function 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.