Juergen Posted July 12, 2022 Posted July 12, 2022 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 Quote
mhupp Posted July 12, 2022 Posted July 12, 2022 (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 July 12, 2022 by mhupp Quote
BIGAL Posted July 13, 2022 Posted July 13, 2022 (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 July 13, 2022 by BIGAL Quote
Juergen Posted July 13, 2022 Author Posted July 13, 2022 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. Quote
BIGAL Posted July 14, 2022 Posted July 14, 2022 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. Quote
Recommended Posts
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.