Jump to content

Chamfer a polyline with VBA


iTijn

Recommended Posts

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 10 years later...
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

 

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...