Error with Inserting Blocks...!!

[johnbest5673]

Dear friends

New to using VBA with AutCAD. On my drawing I have to plot some line which I am able to plot

using VBA. But when it comes to delete those lines, I have to do it manually. So gave a try to BLOCKS.

When I run the macro, I get following error -

Run-time error - 2145320929(802100f)

AutoCAD is unable to service automation request.

Please help 🙂

Have a nice day

JB

[AubelecBE]

hello.

sr but can you show your code ?

[johnbest5673]

dear

My Code --

------------------------------------------

Sub PlotArcs()

    Dim lineLen As Double
    Dim cent1(0 To 2) As Double
    Dim cent2(0 To 2) As Double
    Dim r1(0 To 2) As Double
    Dim r2(0 To 2) As Double
    Dim stPt(0 To 2) As Double
    Dim enPt(0 To 2) As Double
    Dim intPt As Variant
    Dim intPt1(0 To 2) As Double
    Dim intPt2(0 To 2) As Double
    Dim v As Variant
    Dim circle1 As AcadCircle
    Dim circle2 As AcadCircle
    Dim radLen As Double
    Dim nLine As AcadLine
    Dim cirCol As AcadAcCmColor
    Dim verCol As AcadAcCmColor
    
    ' Create the block
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0#
    insertionPnt(1) = 0#
    insertionPnt(2) = 0#
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "PlotARCBlock")
    
    
    Set verCol = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
    Call verCol.SetRGB(255, 10, 255)
    Set cirCol = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
    Call cirCol.SetRGB(91, 91, 91)

    '************ ERROR COMING HERE WHEN DEBUGGED *******************************
    v = ThisDrawing.Utility.GetPoint(, "First Circle Center Point... ")
    cent1(0) = v(0)
    cent1(1) = v(1)
    cent1(2) = v(2)
    v = ThisDrawing.Utility.GetPoint(, "Select the Radius Point for First Circle... ")
    r1(0) = v(0)
    r1(1) = v(1)
    r1(2) = v(2)
    Set nLine = blockObj.AddLine(cent1, r1)
    radLen = nLine.Length
    Set circle1 = blockObj.AddCircle(cent1, radLen)
    'Set circle1 = ModelSpace.AddCircle(cent1, radLen)
    circle1.TrueColor = cirCol
    Set circle2 = blockObj.AddCircle(r1, radLen)
    'Set circle2 = ModelSpace.AddCircle(r1, radLen)
    circle2.TrueColor = cirCol
    
    intPt = circle1.IntersectWith(circle2, acExtendNone)
    
    ' Print all the intersection points
    Dim I As Integer, j As Integer, k As Integer
    If VarType(intPt) <> vbEmpty Then
        For I = LBound(intPt) To UBound(intPt)
            If k = 0 Then
                intPt1(0) = intPt(j)
                intPt1(1) = intPt(j + 1)
                intPt1(2) = intPt(j + 2)
                'MsgBox "First Point - " & intPt1(0) & ", " & intPt1(1)
            ElseIf k = 1 Then
                intPt2(0) = intPt(j)
                intPt2(1) = intPt(j + 1)
                intPt2(2) = intPt(j + 2)
                'MsgBox "Second Point - " & intPt2(0) & ", " & intPt2(1)
            End If
            I = I + 2
            j = j + 3
            k = k + 1
        Next
    End If
    
    Set nLine = blockObj.AddLine(intPt2, intPt1)
    'Set nLine = ModelSpace.AddLine(intPt2, intPt1)
    lineLen = nLine.Length
    nLine.TrueColor = cirCol
    Dim ang As Double
    ang = ThisDrawing.Utility.AngleFromXAxis(intPt1, intPt2)
    
    'Now plotting the Outer Arc
    Dim arcObj As AcadArc
    Dim startAngleInRadian As Double
    Dim endAngleInRadian As Double
    startAngleInRadian = 270 * 3.141592 / 180#
    endAngleInRadian = 90 * 3.141592 / 180#
    
    Set arcObj = blockObj.AddArc(cent1, lineLen, startAngleInRadian, endAngleInRadian)
    'Set arcObj = ModelSpace.AddArc(cent1, lineLen, startAngleInRadian, endAngleInRadian)
    arcObj.TrueColor = verCol
    
    ' Insert the block
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 5000#: insertionPnt(1) = 5000#: insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "PlotARCBlock", 1#, 1#, 1#, 0)
    
End Sub

---------------------------------------

Please help 🙂

Have a nice day

[bojko108]

What is the version of autocad you are using? I think that this error means that other process is running and the AutoCAD wait's for you to enter a command (instead you call GetPoint method). Look where you call that procedure (PlotArcs()) and make shure that the other process are closed. I'm using AutoCAD 2006 and the code you give runs without errors, so check how you call the procedure PlotArcs().

EDIT: If you are using UserForm try to hide it before calling GetPoint method.

[johnbest5673]

Me too using 2006..!!

But getting the same error....

Have a nice day

JBest

[AubelecBE]

try to use this :

  Set CCouleur = New AcadAcCmColor
  Call CCouleur.SetRGB(CR, CV, CB)
  Layer.TrueColor = CCouleur

....

...

  Set CCouleur = Nothing

it is you getapplication ... causing the error with my acad R2004.

change CCouleur with your name in your prog.

Sr. i don't have time for check your code.

+

[johnbest5673]

dear friends,

its working now....

just replaced 5000 with 0. 🙂

But now when I run it number of times, all the earlier plots are

also visible. It means that the block is storing them.

How to clear that block so that everytime I plot. I get a fresh

plot, instead of all the previous plots?

have a nice day

Jbest