Jump to content

Search the Community

Showing results for tags 'vba'.

  • Search By Tags

    Type tags separated by commas.
  • Search By Author

Content Type


Forums

  • 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

Categories

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

Find results in...

Find results that contain...


Date Created

  • Start

    End


Last Updated

  • Start

    End


Filter by number of...

  1. Hi I have this code; Sub selectABlockOnALayer() Dim sset As AcadSelectionSet Set sset = ThisDrawing.SelectionSets.Add("EXCEPTIONS-BLOCK3") Dim filterType As Variant Dim filterData As Variant Dim p1(0 To 2) As Double Dim p2(0 To 2) As Double Dim grpCode(0 To 1) As Integer grpCode(0) = 8 grpCode(1) = 2 filterType = grpCode Dim grpValue(0 To 1) As Variant grpValue(0) = "FXPM" grpValue(1) = "4PLUG" filterData = grpValue sset.Select acSelectionSetAll, p1, p2, filterType, filterData Debug.Print "Entities: " & str(sset.count) sset.Delete End Sub I understand the code only selects 1 type of block on a layer but I cant even get that to work! I am trying to select 89 different types of block that exist on a specific layer. Is this something that can be done using VB? Any advice would be great. Thanks Tom
  2. Hi all, I need to use trim and boundary command in VBA..But the entities should be passed from code to the command. (i.e) selection of entities for trimming and the portion to be trimmed off should be sent from code to the sendcommand..How to pass it in sendcommand.any suggestions?
  3. I created a drawing that varies hole spacing on a peice of angle iron using parameters,but it would be very beneficial to incorporate if-then statements to control the value of some of parameters based on the value of other parameters. An example of this is, if d1 parameter = 14 then d2parameter = 3 elesif d1 parameter = 15 then d2 parameter = 2. I got this idea from iLogic in Inventor, which is very easy to use. Im aware AutoCAD does not have this functionallity, but I think programing such as VBA could help me with my issue. I do not have a strong programing backround so any advise is appretiated.
  4. Hi all, I have a task of numbering polygons which are inside another polygon from left to right order.there may be any number of rows of polygons in a big polygon.Need to number from top left to the right go down to next row and number further.Any code of completing this task in VBA? Awaiting your valuable replies. P.S Attached JPEG for further clarrification...
  5. I m new to ASD, using VBA macros i want to make automated reinforcement process. I've imported autocad file inside ASD and need to generate reinforcement automatically inside ASD only. I know this is possible but i m not getting it. does anybody have any idea for doing this ?
  6. I'm trying to plot model space to PNG using VBA. How do I set ShadePlot=Shaded and Quality=Maximum? These settings don't seem to be stored in the pc3 file and ActiveLayout doesn't have a ShadePlot or quality property. I need to set these to get filled text and lines in the png file. Thanks,
  7. Hello All I'm trying to write a vba routine which allows me to get the starting width and length of a polyline shape by specifying three points. The polyline will usually be made up of orthographic straight lines (but not always) Points 1 and 2 are the start and end points of the first side, from which I get the starting width and angle of the first side. Point 3 is a point anywhere on the opposite side. The length of the bay is the perpendicular distance between Point 3 and the first side (a line joining Points 1 & 2). I have written a (crude) LISP routine using vlax-curve-getClosestPointTo, but I now would like to write a vba routine to achieve the same thing. The purpose of the routine is to assist in the production of pre-cast floor layout drawings. The polyline shape would be a bay in a building drawing; the width would provide the pre-cast beam length; the length would provide the length of flooring to fill. Can anybody please help or point me in the right direction? Many thanks ;; dtr - degrees to radians ;; rtd - radians to degrees (defun dtr (a) (* pi (/ a 180.0)) ) (defun rtd (a) (/ (* a 180.0 pi)) ) (defun C:bay (/ pt1 pt2 pt3 pt4) (setq OrigCmdEcho (getvar "CMDECHO")); gets CMDECHO value (setvar "CMDECHO" 0); sets to 0 - wont echo on command line (vl-load-com) (setq pt1 (getpoint "\Enter Point 1 : ")) (setq pt2 (getpoint pt1 "\nEnter point 2 : ")) (setq myline (command "_line" pt1 pt2 ""));draws 1st line (setq mylinename (entlast));obtain entity name of myline (setq pt3 (getpoint pt2 "\nEnter Point 3 : ")); get point on opposite side of rectangle (setq Span (distance pt1 pt2)); sets Span = length of myline (setq ang1 (angle pt1 pt2)); sets ang1 equal to line angle (setq mylinenamevla (vlax-ename->vla-object mylinename)); converts to vla object (setq pt4 (vlax-curve-getClosestPointTo mylinenamevla pt3 T)); gets perpendicular point (setq perpline (command "_line" pt3 pt4 "")); draws perpendicular line (setq perplinename (entlast));obtain entity name of perpline (setq bayl (distance pt3 pt4)); sets bay length to length of perpline (princ "\nSpan is : ")(princ Span) (princ "\nBay length is : ")(princ bayl) (command "_erase" mylinename "") (command "_erase" perplinename "") (setvar "CMDECHO" OrigCmdEcho); puts back to original value (princ) )
  8. I am trying to create a custom attribute editor by using fixo and metal_pro's code as a base but I'm getting runtime error '424' object required. The de****** is pointing out line AttList = oBlkRef.GetAttributes but I can't figure out what's wrong. I know the basic's of VBA but i'm new to it, so any help would be appreciated. Option Explicit Dim oBlkRef As AcadBlockReference Sub Change_it() Dim inspt As Variant Dim oEnt As AcadEntity Dim i ParentSymbolForm.Hide ThisDrawing.Utility.GetEntity oEnt, inspt, "Select object:" ' Checks if you selected a block. If TypeOf oEnt Is AcadBlockReference Then Set oBlkRef = oEnt ' Check for attributes. If oBlkRef.HasAttributes Then Dim AttList As Variant ' Build a list of attributes for the current block. AttList = oBlkRef.GetAttributes ' Cycle throught the list of attributes. For i = LBound(AttList) To UBound(AttList) ' Check for the correct attribute tag. If AttList(i).TagString = "TAG1" Then ParentSymbolForm.ComponetTag.Text = AttList(i).TextString End If If AttList(i).TagString = "DESC1" Then ParentSymbolForm.TextBoxDesc1.Text = AttList(i).TextString End If If AttList(i).TagString = "DESC2" Then ParentSymbolForm.TextBoxDesc2.Text = AttList(i).TextString End If If AttList(i).TagString = "TERM01" Then ParentSymbolForm.TextBoxPin1.Text = AttList(i).TextString End If If AttList(i).TagString = "POS1" Then ParentSymbolForm.TextBoxSwPos1.Text = AttList(i).TextString End If Next End If ParentSymbolForm.Show Else MsgBox "You did not select a block." End If End Sub Private Sub SelectButton_Click() Call Change_it End Sub Private Sub ChangeButton_Click() Me.Hide Dim AttList As Variant Dim i ' Change attributes for the selected block. AttList = oBlkRef.GetAttributes ' Cycle throught the list of attributes. For i = LBound(AttList) To UBound(AttList) ' Check for the correct attribute tag. Select Case AttList(i).TagString Case "TAG1" AttList(i).TextString = ParentSymbolForm.ComponetTag.Text Case "DESC1" AttList(i).TextString = ParentSymbolForm.TextBoxDesc1.Text Case "DESC2" AttList(i).TextString = ParentSymbolForm.TextBoxDesc2.Text Case "TERM01" AttList(i).TextString = ParentSymbolForm.TextBoxPin1.Text Case "POS1" AttList(i).TextString = ParentSymbolForm.TextBoxSwPos1.Text End Select Next End Sub
  9. 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.
  10. 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
  11. 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
  12. 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
  13. 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
  14. 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.
  15. 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?
  16. 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?
  17. 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?
  18. frenkas

    MLINE SPLIT in VBA

    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
  19. 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?
  20. 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...