below is the sub to open AutoCAD pr 1

[keeyean]

below is the sub to open AutoCAD program... but how do i change it to.. when i had open a AutoCAD file... then.. it will on automatically open another blank AutoCAD new file??


Public Sub OpenAutoCAD()
Dim DwgName As String
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application&quot

If Err Then
Set acadApp = CreateObject("AutoCAD.Application&quot
Err.Clear
End If
If Right(App.Path, 1) = "\" Then
DwgName = App.Path & "facility.dwg"
Else
DwgName = App.Path & "\facility.dwg"
End If
Set acadDoc = acadApp.activedocument
If acadDoc.fullname <> DwgName Then
acadDoc.Open DwgName
End If
acadApp.Visible = True
End Sub

 

[dsi]

I am not real sure what your question is. If you want to close the blank (new) drawing that is automatically opened when you start AutoCAD, just close the active document before opening facility.dwg.

Note:
You should put the Err.Clear command before the CreateObject statement, handling the error before proceeding with the program.

If Err Then
    Err.Clear
    Set acadApp = CreateObject("AutoCAD.Application")
End If

DimensionalSolutions@Core.com
While I welcome e-mail messages, please post all thread activity in these forums for the benefit of all members.

 

[keeyean]

sorry.. i didn't make it clear that what i want...
i'm trying to change the code to.. when it detect the AutoCAD program is opened.. then it will open another AutoCAD blank file...
for example...
case1.) an AutoCAD file has already opened... so when i run the sub... it will open another AutoCAD file(so that, there will have 2 autocad drawings in the autocad program... one is the existing program.. and second is opened by the code)...
case2.) when don't have any autocad opened... then it will open an autocad file..so it will only have 1 autocad drawing in the autocad program

i wish i make it clear this time...

 

[dsi]

You can do this in your error trap. If AutoCAD is already opened, the GetObject will not return an error. If this is the case, just open a new drawing. I have added the Else statement your error check.

Public Sub OpenAutoCAD()
  Dim DwgName As String
  On Error Resume Next
  Set acadApp = GetObject(, "AutoCAD.Application")

  If Err Then  'AutoCAD is Not Opened
    Set acadApp = CreateObject("AutoCAD.Application")
    Err.Clear
  Else         'AutoCAD is Already Opened
    'Open a new drawing here
  End If

  If Right(App.Path, 1) = "\" Then
    DwgName = App.Path & "facility.dwg"
  Else
    DwgName = App.Path & "\facility.dwg"
  End If

  Set acadDoc = acadApp.activedocument

  If acadDoc.fullname <> DwgName Then
    acadDoc.Open DwgName
  End If

  acadApp.Visible = True
End Sub

DimensionalSolutions@Core.com
While I welcome e-mail messages, please post all thread activity in these forums for the benefit of all members.

 

[keeyean]

but what is the 'Open a new drawing&quot; code??

coz i have tried the code that you corrected... but i still the same.. i can open a new AutoCAD file...(

 

[dsi]

The AutoCAD help file has a sample of this. Look up the Add method (Add method, Documents collection) and hit the sample code button.

Sub Ch3_NewDrawing()
    Dim docObj As AcadDocument
    Set docObj = ThisDrawing.Application.Documents.Add
End Sub

DimensionalSolutions@Core.com
While I welcome e-mail messages, please post all thread activity in these forums for the benefit of all members.

 

[dsi]

Actually, in VB, I don't think you have access to the ThisDrawing object. By expanding your sample, you would use this command:

acadApp.Documents.Add

DimensionalSolutions@Core.com
While I welcome e-mail messages, please post all thread activity in these forums for the benefit of all members.

 

[keeyean]

wooh.. you are the expert in this..
i should come here earlier ask my questions....i really spend a lot of time to look for the answers....
anyway.. thank a lot!!!

 

[tigrek]

Well, keeyan. I gave dsi the star you forgot to give. This is really useful VBA code.

 

[dsi]

tigrek & keeyean: Glad I could help!
DimensionalSolutions@Core.com
While I welcome e-mail messages, please post all thread activity in these forums for the benefit of all members.

 

[CTruax]

'From VB6 I can prompt for and receive two ACAD points:

Dim a, b, R As Variant
a = utilObj.GetPoint(, vbCrLf & &quot;Start of shear wall: &quot
b = utilObj.GetPoint(a, vbCrLf & &quot;End of shearwall: &quot

'but I am not able to determine the angle R:

R = utilObj.AngleFromXAxis(a, b)

'because of a 'Type Mismatch' error. The AngleFrom
'function expects 3-element array of doubles.
'How can I convert the 'a' variant to 3-element doubles.

 

[dsi]

You have not defined your variables correctly:

Dim a(0 To 2) As Double
Dim b(0 To 2) As Double
Dim R As Double

DimensionalSolutions@Core.com
While I welcome e-mail messages, please post all thread activity in these forums for the benefit of all members.

 

[CTruax]

If you
DIM a(0 to 2)
then an error comes up on the 'GETPOINT' line when you try to run it

 

[CTruax]

If you
DIM a(0 to 2)
then an error comes up on the 'GETPOINT' line when you try to run it

 

[dsi]

Sorry, I forgot that the GetPoint requires a variant return. You will need to put these values into an arrayed double. Unfortunately, I have not found an easier way to do this.

Dim utilObj As Object
    
Dim a, b
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Dim dAng As Double
    
Set utilObj = ThisDrawing.Utility
    
a = utilObj.GetPoint(, vbCrLf & "Start of shear wall: ")
pt1(0) = a(0): pt1(1) = a(1): pt1(2) = a(2)

b = utilObj.GetPoint(a, vbCrLf & "End of shearwall: ")
pt2(0) = b(0): pt2(1) = b(1): pt2(2) = b(2)

dAng = ThisDrawing.Utility.AngleFromXAxis(pt1, pt2)

DimensionalSolutions@Core.com
While I welcome e-mail messages, please post all thread activity in these forums for the benefit of all members.

 

[cowski]

I cut and pasted the code above (dsi's) then modified it to use the variants (a and b) directly. It ran with no problems (I am using AutoCAD 2000 and ran the code through VBA). Maybe I need to run it through VB6 to get the same error?

Dim utilObj As Object
Dim a, b
Dim dAng As Double

Set utilObj = ThisDrawing.Utility
a = utilObj.GetPoint(, vbCrLf & &quot;Start of shear wall: &quot
b = utilObj.GetPoint(a, vbCrLf & &quot;End of shearwall: &quot
dAng = ThisDrawing.Utility.AngleFromXAxis(a, b)