Jump to content

Recommended Posts

Posted

Hi,

I copy the text from a .txt file.

In AutoCad I click with the right mousekey into the command line and

click on insert (Einfügen) and all the rectangles will be created in the drawing.

 

Is there a way to copy the text only in excel and bring them to AutoCad with

the SendCommand command?

 

Thanks for your help.

https://ibb.co/zXn36Y8

Posted (edited)

This will first check to see if AutoCAD is open,  Change to model space, and for each cell that is selected send the text to the command line.

 

Sub CMDSend()
' Keyboard Shortcut: Ctrl+Shift+P
    Dim app As Object, Doc As Object, Cmd As String, rng As Range, i As Long
    On Error Resume Next
    Set App = GetObject(, "AutoCAD.Application")
    If app Is Nothing Then
        MsgBox "AutoCAD isns't Open!", vbCritical, "Input Error"
        Exit Sub
    End If
    Set Doc = app.ActiveDocument
    'Check if the active space is paper space and change it to model space.
    If Doc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
       Doc.ActiveSpace = 1      '1 = acModelSpace in early binding
    End If
    Set rng = Selection  'set a range of cells
    For Each rng In Selection.Cells
      If rng.Value > 0 Then  'if cell isn't blank send command
         Cmd = rng.Value
         Doc.SendCommand Cmd & vbCr
      End If
    Next rng
End Sub

 

Edited by mhupp
Posted (edited)

You could write a rectang sub for use within excel just pass the 4 corner values x1 y1 x2 y2 etc. Look at end for "pline". I am no expert on using this method just done to see what I could do.

 

  
Public Sub Opendwg()
 
    Dim acadApp As Object
    Dim acadDoc As Object

 'Check if AutoCAD application is open. If is not opened create a new instance and make it visible.
    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    If acadApp Is Nothing Then
        Set acadApp = CreateObject("AutoCAD.Application")
        acadApp.Visible = True
    End If
 
    'Check (again) if there is an AutoCAD object.
    If acadApp Is Nothing Then
        MsgBox "Sorry, it was impossible to start AutoCAD!", vbCritical, "AutoCAD Error"
        Exit Sub
    End If
    On Error GoTo 0
 
    'If there is no active drawing create a new one.
    On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
    If acadDoc Is Nothing Then
        Set acadDoc = acadApp.Documents.Add
    End If
    On Error GoTo 0
  
    'Check if the active space is paper space and change it to model space.
    If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
        acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
    End If

 End Sub
 
Public Sub addline(x1, y1, z1, x2, y2, z2)
  
 ' Create the line in model space
    'Dim acadApp As Object
    'Dim acadDoc As Object
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument

    Dim startpoint(0 To 2) As Double
    Dim endpoint(0 To 2) As Double
    Dim lineobj As Object

    startpoint(0) = x1: startpoint(1) = y1: startpoint(2) = z1
    endpoint(0) = x2: endpoint(1) = y2: endpoint(2) = z2

    Set lineobj = acadDoc.ModelSpace.addline(startpoint, endpoint)
    acadApp.ZoomExtents
    
    End Sub
    Public Sub addcirc(x1, y1, z1, rad)
  
 ' Create the circle in model space
   ' Dim acadApp As Object
   ' Dim acadDoc As Object
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument

    Dim cenpoint(0 To 2) As Double
   
    Dim circobj As Object

   cenpoint(0) = x1: cenpoint(1) = y1: cenpoint(2) = z1
    Set circobj = acadDoc.ModelSpace.addcircle(cenpoint, rad)
    acadApp.ZoomExtents
    
    End Sub
    
    
    Sub addpoly(cords, col)
    
    ' Dim acadApp As Object
    ' Dim acadDoc As Object
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument

    Dim oPline As Object
    
' add pline to Modelspace
Set oPline = acadDoc.ModelSpace.AddLightWeightPolyline(cords)
oPline.Color = col

End Sub
   
    Sub alan1()
    
   
' This example adds a line in model space
' Define the start and end points for the line
   
    px1 = 1
    px2 = 5
    py1 = 1
    py2 = 5
    pz1 = 0
    pz2 = 0
    

Call addline(px1, py1, pz1, px2, py2, pz2)

End Sub

 Sub alan2()
 
    px1 = 1
    py1 = 1
    pz1 = 0
    Radius = 8.5
 
 Call addcirc(px1, py1, pz1, Radius)

 End Sub
 
 Sub alan3()
 'Dim coords(0 To n) As Double
 Dim coords(0 To 5) As Double
 coords(0) = -6: coords(1) = 1:
 coords(2) = 3: coords(3) = 5:
 coords(4) = 7.55: coords(5) = 6.25:
 
 col = 1
    
 Call addpoly(coords, col)

 End Sub

 

Edited by BIGAL
Posted

Hi mhupp, hi bigal,

 

thanks for your answers and taking your time.

 

@mhupp I'm currently doing it with the Doc.SendCommand to bring them cell by cell to AutoCad.

In the step of copying and pasting into the command line, it seems to me that it would go faster than reading each cell by cell.

(it's handwork)

I thought there was an insert command in the command line to paste from clipboard

 

@bigal

Thanks for the program, there are many useful approaches for me.

 

Posted

Select range Ctrl+C, click onto Autocad command line Ctrl+V not sure how much simpler, Ahhh but I remember now a problem for a certain task if does not work. Select column excel, click EDIT, Paste special, script text.

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...