visual basic using autocad

[jayaram]

i need your help... i want to draw a square or a rectangle by programming,i.e if i write a code in visual basic then i must get the output as a square in auto cad in a top view.can you tell me what is the code for getting a square as an output in auto cad and what are the steps that have to be followed in order to get the out in auto cad by using the api's.could you tell the step by step procedure???

[lpseifert]

Have a look here, there are VB/VBA tutorials

http://www.afralisp.net/

[Lee Mac]

If you are just starting to program for AutoCAD, I would suggest using LISP instead - VBA is slowly getting phased out of AutoCAD.

[jayaram]

i want a simple code to draw a square and a rectangle using vb only. i cant use lisp...can any one get me the code to draw a simple square and rectangle so that i get the output in the auto cad... along with the steps???

[SEANT]

It sounds like you need a LightWeight Polyline. If that is the case then look in the VBA help reference for the AddLightWeightPolyline method. I modified the example given in that reference to produce a 10 x 10 square.

 

Sub Example_AddLightWeightPolyline()
   ' This example creates a lightweight polyline in model space.
   
   Dim plineObj As AcadLWPolyline
   Dim points(0 To 9) As Double
   
   ' Define the 2D polyline points
   points(0) = 0: points(1) = 0
   points(2) = 10: points(3) = 0
   points(4) = 10: points(5) = 10
   points(6) = 0: points(7) = 10
   points( = 0: points(9) = 0
       
   ' Create a lightweight Polyline object in model space
   Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
   plineObj.Closed = True
   ZoomAll
   
End Sub

[jayaram]

what i need is they will give the value for the square in excel,it must read the value from it and it must draw a square(output will be in auto cad) but the code will be in visual basic...

[SEANT]

I understand the stress associated with tight deadlines. But, if you “need the help badly as soon as possible . . . “ then you have to take some time to pose a request in such a way to allow us to help. Explain all the parameters, post example files, etc.

 

Here are a few links that demonstrate a VBA AutoCAD/Excel hook.

 

http://www.cadtutor.net/forum/showthread.php?t=36125

http://www.cadtutor.net/forum/showthread.php?t=15738

[jayaram]

thank you sir i understood about the excel sheet...but can i now the code to draw a square such a way that i get the output in auocad and the code must be written in visual basic... i need a code like that for a simple square and rectangle...

[rkmcswain]

"jayaram" - this is not a free programming code wishlist website. There are people here who can help you with your own programming effort, but it's doubtful that you will find someone to take your specific requests and write a complete program for you. We are all users who come here on our own time, without compensation.

[jayaram]

ok sorry...

[fixo]

thank you sir i understood about the excel sheet...but can i now the code to draw a square such a way that i get the output in auocad and the code must be written in visual basic... i need a code like that for a simple square and rectangle...

Give that a shot

 

Option Explicit
'' File Open Dialog
'' author unknown
Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
                                       Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Type OPENFILENAME
   lStructSize As Long
   hwndOwner As Long
   hInstance As Long
   lpstrFilter As String
   lpstrCustomFilter As String
   nMaxCustFilter As Long
   nFilterIndex As Long
   lpstrFile As String
   nMaxFile As Long
   lpstrFileTitle As String
   nMaxFileTitle As Long
   lpstrInitialDir As String
   lpstrTitle As String
   flags As Long
   nFileOffset As Integer
   nFileExtension As Integer
   lpstrDefExt As String
   lCustData As Long
   lpfnHook As Long
   lpTemplateName As String
End Type
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
' Display and use the File open dialog
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
Public Function ShowOpen() As String
   Dim strTemp As String
   Dim VertName As OPENFILENAME
   VertName.lStructSize = Len(VertName)
   VertName.hwndOwner = ThisDrawing.HWND
   VertName.lpstrFilter = "All Excel Files (*.xls)" + Chr$(0) + _
                          "*.xls" + Chr$(0) + " | " + "Excel Files (*.xlsx)" + Chr$(0) + _
                          "*.xlsx"
   VertName.lpstrFile = Space$(254)
   VertName.nMaxFile = 255
   VertName.lpstrFileTitle = Space$(254)
   VertName.nMaxFileTitle = 255
   VertName.lpstrInitialDir = CurDir
   VertName.lpstrTitle = "Select Excel File"
   VertName.flags = 0
   If GetOpenFileName(VertName) Then
       strTemp = (Trim(VertName.lpstrFile))
       ShowOpen = Mid(strTemp, 1, Len(strTemp) - 1)
   End If
End Function

Public Sub DrawRectangleEx()
   Dim xlFileName As String
   On Error GoTo Err_Control
   xlFileName = ShowOpen()
   Dim Excel As Object
   On Error Resume Next
   Set Excel = GetObject(, "Excel.Application")
   If Err Then
       Err.Clear
   End If
   On Error GoTo 0
   Set Excel = CreateObject("Excel.Application")
   If Err Then
       MsgBox "Could not load Excel.", vbExclamation
       End
   End If
   Dim xlBook As Object
   Dim xlSheet As Object
   Excel.Visible = True
   Set xlBook = Excel.Workbooks.Open(xlFileName)
   Set xlSheet = xlBook.Worksheets("Sheet1") ' <--change sheet name or sheet number here
   xlSheet.Activate
   Dim xlRange As Object
LengthCell:
   Set xlRange = Excel.Application.InputBox(Prompt:="Select Length Of Rectangle", Type:=
   If xlRange.Rows.Count <> 1 Or xlRange.Columns.Count <> 1 Then
       MsgBox "Select Single Cell Only"
       GoTo LengthCell
   End If
   Dim Leng As Double
   Leng = CDbl(xlRange.Cells(1, 1).Value)
WidthCell:
   Set xlRange = Excel.Application.InputBox(Prompt:="Select Width Of Rectangle", Type:=
   If xlRange.Rows.Count <> 1 Or xlRange.Columns.Count <> 1 Then
       MsgBox "Select Single Cell Only"
       GoTo WidthCell
   End If
   Dim Wid As Double
   Wid = CDbl(xlRange.Cells(1, 1).Value)
   Set xlRange = Nothing
   Set xlSheet = Nothing
   xlBook.Close False
   Set xlBook = Nothing
   Excel.Quit
   Dim lh As Double
   Dim wh As Double
   lh = Leng / 2
   wh = Wid / 2
   Dim cp As Variant
   cp = ThisDrawing.Utility.GetPoint(, vbCr & "Pick center point of the rectangle:")
   Dim pts(0 To 7) As Double
   pts(0) = cp(0) - lh: pts(1) = cp(1) - wh
   pts(2) = cp(0) + lh: pts(3) = pts(1)
   pts(4) = pts(2): pts(5) = cp(1) + wh
   pts(6) = pts(0): pts(7) = pts(5)
   Dim oPline As AcadLWPolyline
   Set oPline = ThisDrawing.ActiveLayout.Block.AddLightWeightPolyline(pts)
   oPline.Closed = True
   ZoomExtents
Err_Control:
   If Err Then MsgBox Err.Description
End Sub

 

~'J'~