Jump to content

Search the Community

Showing results for tags 'vba'.

More search options

  • Search By Tags

    Type tags separated by commas.
  • Search By Author

Content Type


  • CADTutor
    • News, Announcements & FAQ
    • Feedback
  • AutoCAD
    • AutoCAD Beginners' Area
    • AutoCAD 2D Drafting, Object Properties & Interface
    • AutoCAD Drawing Management & Output
    • AutoCAD 3D Modelling & Rendering
    • AutoCAD Vertical Products
    • AutoCAD LT
    • CAD Management
    • AutoCAD Bugs, Error Messages & Quirks
    • AutoCAD General
    • AutoCAD Blogs
  • AutoCAD Customization
    • The CUI, Hatches, Linetypes, Scripts & Macros
    • AutoLISP, Visual LISP & DCL
    • .NET, ObjectARX & VBA
    • Application Beta Testing
    • Application Archive
  • Other Autodesk Products
    • Autodesk 3ds Max
    • Autodesk Revit
    • Autodesk Inventor
    • Autodesk Software General
  • Other CAD Products
    • BricsCAD
    • SketchUp
    • Rhino
    • SolidWorks
    • MicroStation
    • Design Software
    • Catch All
  • Resources
    • Tutorials & Tips'n'Tricks
    • AutoCAD Museum
    • Blocks, Images, Models & Materials
    • Useful Links
  • Community
    • Introduce Yourself
    • Showcase
    • Work In Progress
    • Jobs & Training
    • Chat
    • Competitions


  • Programs and Scripts
  • 2D AutoCAD Blocks
  • 3D AutoCAD Blocks
  • Images
    • Backgrounds

Find results in...

Find results that contain...

Date Created

  • Start


Last Updated

  • Start


Filter by number of...

Found 62 results

  1. Maybe someone can help me out here. Is it possible that I can create a link between dimensions (width & length) of a rectangle in AutoCAD, and two cells in a pre-existing Excel sheet; so when I modify the size of this rectangle in AutoCAD, the cells will also get updated? I'm using AutoCAD 2002, 2006 & Excel 2003.
  2. tigger29900

    Clear Button

    Hi i was looking to create a button that sets all the unlocked layers in my drawing back to color 7 I've been trying to get it but no luck any help would be appreciated
  3. meyerforhire

    Keystroke Queue vba HELP

    I am working on a routine that, at one point, goes into a Do loop and reacts to keystroke input via the GetAsyncKeystroke API. The routine looks at the arrow keys and a couple others and translates those keystrokes into activating flip and angle states of the dynamic block selected--giving the user and interactive tool for block manipulation. Anyway, the issue I'm having is that when the loop is complete, all of the keystrokes pressed while in the loop come rushing into the command line. I've been very careful to choose keys for the routine which do not have a command or shortcut associated with them. However, the UP arrow key is the kicker. I would like to keep it in the routine because it's obvious when using the others. Plus, even if I don't use it, I'm sure users will still hit it while using the other arrow keys. What I would like to be able to do, is prevent all of those keystrokes from going back into the command line when the sub is complete. I've tried using the SetKeyboardState API after each keystroke to try to cover my tracks. But, it doesn't do anything. My guess is that there is some keystroke queue that needs to be cleared prior to exiting the sub. Does anyone know if it exists and, if so, how to clear it? If it doesn't exist, is there some Acad variable I can turn off? Is there a system variable, etc.....? I've briefly looked at keystroke hooks, but they seem awfully involved and complicated and I'm not even sure if it will do what I want. Any help?????? Oh, and yes I know, I should quit using vba for .NET.....I know. Also, I have no interest in converting my code into lisp. I can use lisp to do some very basic tasks. I could use lisp to set a variable if need be, but I don't want to go "all out" with it. Thanks in advance. Here's a snippet of the code: Do U = GetAsyncKeyState(VK_UP) D = GetAsyncKeyState(VK_DOWN) L = GetAsyncKeyState(VK_LEFT) R = GetAsyncKeyState(VK_RIGHT) A = GetAsyncKeyState(VK_RCONTROL) 'Ret = GetAsyncKeyState(VK_RETURN) 'Space = GetAsyncKeyState(VK_SPACE) S = GetAsyncKeyState(VK_RSHIFT) If (Rot >= 0 And Rot <= 45) Or (Rot >= 135 And Rot <= 225) Or Rot >= 315 Then If HasH And (U < 0 Or D < 0) Then Set objDyn = DynProps(h) If Hflip = 0 Then objDyn.Value = 1 objRef.Update objRef.Highlight True Exit Do Else objDyn.Value = 0 objRef.Update objRef.Highlight True Exit Do End If ElseIf HasV And (R < 0 Or L < 0) Then Set objDyn = DynProps(v) If Vflip = 0 Then objDyn.Value = 1 objRef.Update objRef.Highlight True Exit Do Else objDyn.Value = 0 objRef.Update objRef.Highlight True Exit Do End If ElseIf A < 0 And HasRot Then Set objDyn = DynProps(t) objDyn.Value = Rad - (¶ / 2) objRef.Update objRef.Highlight True Exit Do ElseIf S < 0 Then 'Ret < 0 Or Space < 0 Then Done = True Exit Do End If Else If HasV And (U < 0 Or D < 0) Then Set objDyn = DynProps(v) If Vflip = 0 Then objDyn.Value = 1 objRef.Update objRef.Highlight True Exit Do Else objDyn.Value = 0 objRef.Update objRef.Highlight True Exit Do End If ElseIf HasH And (R < 0 Or L < 0) Then Set objDyn = DynProps(h) If Hflip = 0 Then objDyn.Value = 1 objRef.Update objRef.Highlight True Exit Do Else objDyn.Value = 0 objRef.Update objRef.Highlight True Exit Do End If ElseIf A < 0 And HasRot Then Set objDyn = DynProps(t) objDyn.Value = Rad - (¶ / 2) objRef.Update objRef.Highlight True Exit Do ElseIf S < 0 Then 'Ret < 0 Or Space < 0 Then Done = True Exit Do End If End If Loop
  4. tigger29900

    Layer Properties using VBA

    Newbie here i have been using this forum frequently as of late and had a question i was hoping you could help me with. I am building a program in visual basic to select certain layers and change their color to outline a certain path on a layer diagram. I need to program a clear button that sets all of the layer colors back to color 7 as efficiently as possible any help would be appreciated Secondly and less important I was trying to figure out a way to select all of the text in the selected layers and export them to excel to build an effected equipment list. )I'm not sure if this is even possible) Any help would be greatly appreciated
  5. Bill_Myron

    Convert Ellipse to Arc

    I have been trying to figure this out for a couple of days now. The only thing I could find is this LISP that takes the Ellipse properties and uses them to creat an arc. When I use this, the start and end angles are not correct in the drawing. Ellipses must have been drawn in a different UCS). I have tried to get the LISP to use the start and end points of the ellipse along with the radius and center point. For the life of me I cannot figure it out. If anyone knows how to do this please let me know. *NOTE* Elllipses that I am trying to convert have the same minor and major radii. Thanks in advance!! (defun c:e2a (/ acaddoc acadms acadobj center endangle obj radius ss ssn startangle) (vl-load-com) (if (setq ss (ssget '((0 . "ellipse")))) (progn (setq acadobj (vlax-get-acad-object)) (setq acaddoc (vla-get-activeDocument acadobj)) (setq acadms (vla-get-modelspace acaddoc)) (setq ssn (ssname ss 0)) (setq obj (vlax-ename->vla-object ssn)) (if obj ;(equal (vla-get-RadiusRatio obj) 1 0.0001) (progn (setq radius (vla-get-MajorRadius obj)) (setq Startangle (vla-get-Startangle obj)) (setq Endangle (vla-get-Endangle obj)) (setq Center (vlax-get obj 'center)) (entdel ssn) (vla-addarc acadms (vlax-3d-point Center) radius Startangle Endangle) ) ; progn (alert "> Ellipse objects failed to be converted") ) ; if ) ; progn ) ; if (princ) ) ; defun
  6. rodbuilder

    Plot Area?

    I am trying to get the coordinates that is defined in the layout to plot using VBA. I am in model space. I think I need to use GetWindowToPlot but not sure how to do so. I am trying to start programming so things are going slow.
  7. Hi All, is it a way to use vba code directly from within Visual LISP? Assume that we use this visual lisp code: (vla-addcustominfo (vla-get-summaryinfo (vla-get-activedocument (Vlax-get-acad-object)) ) "Key" "Value" ) Is it possible to use: ActiveDocument.SummaryInfo.AddCustomInfo "Key" "Value" inside visual lisp program?
  8. I have created a vba macro to edit attributes in Blocks. I tried so many times but it doesn't update the attributes in drawing, unless I manually do a BATTMAN... What is wrong?
  9. Hi guys. I have written some code in VB for autocad and for the moment i am declaring the coordinates in xyz axis as following: Private Sub CreatePoints() SidePoints(0) = 400: SidePoints(1) = -105.25: SidePoints(2) = 215 SidePoints(3) = N( - 400: SidePoints(4) = -105.25: SidePoints(5) = 215 SidePoints(6) = 400: SidePoints(7) = 0: SidePoints( = 215 SidePoints(9) = N( - 400: SidePoints(10) = 0: SidePoints(11) = 215....... For example sidepoints(0),sidepoints(1),sidepoints(2) (x,y,z) are the coordinates for one point. It would be great if i could just write Sidepoints(400,105.25,215). Is there a simpler way to declare coordinates or that is the only method?
  10. frenkas


    Hello, I've made one very useful tool. It's called MLINE SPLIT and you guessed what it does. However it doesn't work on first and second vertices (1 and 2 vertex), and that is real mystery for me. Why are these vertices so different than all the other vertices. Below is my VBA code: Public Sub MLineSplit() On Error GoTo eh Dim ent As AcadEntity Dim p1 As Variant Dim p2 As Variant Dim x As Double Dim y As Double Dim atst As Double Dim min_atst As Double Dim taskas As Double Dim atst_nustatytas As Boolean Dim dblVertices() As Double Dim dblVerticesCnt As Double Dim dblVertices2() As Double Dim dblVerticesCnt2 As Double Dim sset As AcadSelectionSet Dim perdavimui As Variant Dim obj As AcadMLine Dim obj2 As AcadMLine Dim varpnt As Variant Dim krd(2) As Double Dim aa As Integer Dim objEnt As AcadMLine Dim objEnt2 As AcadMLine ThisDrawing.Utility.GetEntity ent, 1, "Select MLINE: " p2 = ThisDrawing.Utility.GetPoint(, "Select the SPLIT point in MLINE: ") x = p2(0): y = p2(1) atst_nustatytas = False dblVerticesCnt = -1 dblVerticesCnt2 = -1 'randam artimiausia If TypeOf ent Is AcadMLine Then 'AcadBlockRef isrinkimas Set obj = ent 'ThisDrawing.SetVariable "CMLSTYLE", obj.StyleName For aa = 0 To UBound(obj.Coordinates) Step 3 'MsgBox Str(obj.Coordinates(aa)) & "," & Str(obj.Coordinates(aa + 1)) & "," & Str(obj.Coordinates(aa + 2)) atst = DistanceBetween(obj.Coordinates(aa), obj.Coordinates(aa + 1), x, y) If (atst_nustatytas = False) Then min_atst = atst atst_nustatytas = True End If If atst min_atst = atst taskas = aa End If Next aa Else MsgBox "Must select MLINE!" Exit Sub End If Set perdavimui = obj.Copy Set obj2 = perdavimui 'Exit Sub For aa = 0 To UBound(obj.Coordinates) Step 3 'MsgBox obj.Coordinates(aa) 'MsgBox obj.Coordinates(aa + 1) 'MsgBox obj.Coordinates(aa + 2) If aa >= taskas Then dblVerticesCnt = dblVerticesCnt + 3 ReDim Preserve dblVertices(dblVerticesCnt) dblVertices(dblVerticesCnt - 2) = obj.Coordinates(aa) dblVertices(dblVerticesCnt - 1) = obj.Coordinates(aa + 1) dblVertices(dblVerticesCnt) = obj.Coordinates(aa + 2) End If If aa dblVerticesCnt2 = dblVerticesCnt2 + 3 ReDim Preserve dblVertices2(dblVerticesCnt2) dblVertices2(dblVerticesCnt2 - 2) = obj2.Coordinates(aa) dblVertices2(dblVerticesCnt2 - 1) = obj2.Coordinates(aa + 1) dblVertices2(dblVerticesCnt2) = obj2.Coordinates(aa + 2) End If Next aa If ThisDrawing.ActiveSpace = acModelSpace Then If dblVerticesCnt >= 5 Then obj.Coordinates = dblVertices If dblVerticesCnt2 >= 5 Then obj2.Coordinates = dblVertices2 Else If dblVerticesCnt >= 5 Then obj.Coordinates = dblVertices If dblVerticesCnt2 >= 5 Then obj2.Coordinates = dblVertices2 End If obj.Update obj2.Update Exit Sub eh: MsgBox "Error number: " & str(Err.Number) & " . Description: " & Err.Description End Sub
  11. dbroada

    .Import equivalent?

    I am slowly going through my VBA routines looking for an easy one to convert to .NET and I thought I had found one.... Public Sub DxfImport(myFile As String) Dim P1(0 To 2) As Double Dim myScale As Double Dim myTest If Right$(myFile, 4) <> ".dxf" Then myFile = myFile & ".dxf" myTest = Dir$(myFile) If myTest <> "" Then P1(0) = 0: P1(1) = 0: P1(2) = 0 myScale = 1 ThisDrawing.Import myFile, P1, myScale End If End Sub however I can't get past the ThisDrawing.Import line. I have tried [font=Consolas][size=2] [/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]Public[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]Sub[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2] aNewBit([/size][/font][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]ByVal[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2] myFile)[/size][/font] [/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]Dim[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2] acDoc [/size][/font][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]As[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][color=#2b91af][font=Consolas][size=2][color=#2b91af][font=Consolas][size=2][color=#2b91af]Document[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2] = [/size][/font][/size][/font][font=Consolas][size=2][color=#2b91af][font=Consolas][size=2][color=#2b91af][font=Consolas][size=2][color=#2b91af]Application[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2].DocumentManager.MdiActiveDocument[/size][/font] [/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]Dim[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2] p1(0 [/size][/font][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]To[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2] 2) [/size][/font][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]As[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]Double[/color][/size][/font] [/color][/size][/font][/color][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]Dim[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2] myScale [/size][/font][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]As[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]Double[/color][/size][/font] [/color][/size][/font][/color][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]Dim[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2] myTest[/size][/font] [/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]If[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2] Right(myFile, 4) <> [/size][/font][/size][/font][font=Consolas][size=2][color=#a31515][font=Consolas][size=2][color=#a31515][font=Consolas][size=2][color=#a31515]".DXF"[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]Then[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2] myFile = myFile & [/size][/font][/size][/font][font=Consolas][size=2][color=#a31515][font=Consolas][size=2][color=#a31515][font=Consolas][size=2][color=#a31515]".DXF"[/color][/size][/font] [/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2]myTest = Dir(myFile)[/size][/font] [/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]If[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2] myTest <> [/size][/font][/size][/font][font=Consolas][size=2][color=#a31515][font=Consolas][size=2][color=#a31515][font=Consolas][size=2][color=#a31515]""[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]Then[/color][/size][/font] [/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2]p1(0) = 0 : p1(1) = 0 : p1(2) = 0[/size][/font] [size=2][font=Consolas]myScale = 1[/font][/size] [size=2][font=Consolas]acDoc.IMPORT(myFile, p1, myScale)[/font][/size] [/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]Else[/color][/size][/font] [/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2]MsgBox([/size][/font][/size][/font][font=Consolas][size=2][color=#a31515][font=Consolas][size=2][color=#a31515][font=Consolas][size=2][color=#a31515]"File doesn't exist"[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][font=Consolas][size=2])[/size][/font] [/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]End[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]If[/color][/size][/font] [/color][/size][/font][/color][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]End[/color][/size][/font][/color][/size][/font][/color][/size][/font][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff][font=Consolas][size=2][color=#0000ff]Sub[/color][/size][/font] [/color][/size][/font][/color][/size][/font] but as you can see, Import hasn't been found in the acDoc object. Any ideas?
  12. woutervddn

    VBA timer overflow

    hi, I'm working on a program that should make some work at the office run autonomous. People will be able to ask for drawings and get a general idea of the price of their product. To let it all go automatic I used the AutoEdit() command. So when I now open the drawing it updates everything makes the drawing fit the screen, pauses the program (so the drawing has time to adjust), and prints it as a pdf. so after the update this is the code: 'change zoom ThisApplication.ActiveView.Fit 'pause the program Dim Finish As Single Finish = Timer + 5 DoEvents Do Until Timer >= Finish Loop 'create pdf ThisDocument.PrintManager.SubmitPrint The programs runs great and everything works. BUT, since everything must go automatically I don't want to press the drawing. when user click send on the online form the drawing must do everything by itself. To do so I've made a VB program which does this: 'open inventor Dim InvTmp As Inventor.Application InvTmp = CType(CreateObject("Inventor.Application"), Inventor.Application) 'open the document InvTmp.Documents.Open("C:\Users\Wouter\Desktop\T&A\My Dropbox\knowledge base\Fase 3\html to inventor\nozzle.ipt", True) And for some reason this goes wrong. when the document is open and starts the AutoEdit(), VBA tells me that Timer has an runtime-6 error overflow. I can't find the source of this. everthing works when I click the drawing but I can't get it automated because of this. I can't drop the pause cause else the zoom wouldn't be changed by the time the printing starts (with a half drawing as a result) any ideas about how to fix this?
  • Create New...