draw object using VBA

[Anonymous]

Hi,

 I am learning VBA and i don't have much information.

I want to draft same panel using vba.

Could you please guide me, please see attached cad file for object i want to draft. size should be various very time.

[Anonymous]

No one can help ?

[norman.yuan]

Not trying to discourage you from learning, but you really need to explain what "guide" means. How much do you know AutoCAD VBA or programming in general? Not at all, or you can write some basic code/know basic programming? Or you do some VBA programming with other applications (MS Word/Excel...), not know not very much about AutoCAD? Or, how much you know AutoCAD, which is essential before one can do reasonable/practical AutoCAD programming

The forum is a place for peer-to-peer discussion/support between AutoCAD users voluntarily and this particular one is for AutoCAD VBA/COM API programming. The best way to get support/help from other users is to ask concrete technical question, and show what you have done and what is the issue you have in your effort.

With that said, the things showed in your drawing can be easily drawn either manually or by VBA code (or LISP, or script, for that matter). You might want to explain the workflow of doing the work (when/how/which size you want to change (before or after the thing is actually drawn). What kind of AutoCAD entities you want to create (LINE or Polyline, 2D or 3D, block/dynamic block, and so on). 

Without knowing your programming background, your AutoCAD background, the actual workflow of your task and what you have done, it is hard to offer meaningful help. That is why people hesitate to respond,

[Anonymous]

Hi Sir,

Thanks,

Actually, I have not much knowledge about VBA, i have only read codes. I have good knowledge about autocad. 

The uploaded drawing is for panel. sizes of panels are every time different and i should draw each panel manually (reason is different sizes) . that's why i need VBA for it. I will provide you work flow for drafting. Please guide me, so that i can made same vba for another parts of panels.

[Anonymous]

Hi Sir,

Please see attached work flow in cad file.

[parikhnidi]

Hi,

Please see code below. This will serve as some guideline for you to move forward in future. In this program I've not yet implemented logic for drawing weep holes. I am leaving it to you to crack the logic based on code.

Have a fun with programming.

Nimish

Option Explicit

Public Function DrawPanel()

    Dim Length As Double
    Dim Height As Double
    Dim HCount As Double
    Dim VCount As Double
    Dim HDistance As Double
    Dim VDistance As Double
    
    Dim llc As Variant
    Dim lrc(0 To 2) As Double
    Dim urc(0 To 2) As Double
    Dim ulc(0 To 2) As Double
    
    Dim lineObj As AcadLine
    Dim polyObj As AcadPolyline
    Dim circObj As AcadCircle
    
    Dim i As Integer
    
    With ThisDrawing.Utility
        llc = .GetPoint(, "Select Lower Left Corner: ")
        Length = .GetDistance(llc, "Length: ")
        Height = .GetDistance(llc, "Height: ")
    End With
    
    HCount = Round(((Length - 50) / 400) + 0.5, 0) + 1
    VCount = Round(((Height - 50) / 400) + 0.5, 0) + 1
    
    HDistance = (Length - 50) / (HCount - 1)
    VDistance = (Height - 50) / (VCount - 1)
    
    lrc(0) = llc(0) + Length: lrc(1) = llc(1): lrc(2) = llc(2)
    urc(0) = lrc(0): urc(1) = lrc(1) + Height: urc(2) = llc(2)
    ulc(0) = llc(0): ulc(1) = llc(1) + Height: ulc(2) = llc(2)
    
    Dim pt1(0 To 2) As Double
    Dim pt2(0 To 2) As Double
    Dim polyPoint(0 To 11) As Double
    
    With ThisDrawing.ModelSpace
        
        'Draw lower horizontal line
        pt1(0) = llc(0) - 25: pt1(1) = llc(1): pt1(2) = llc(2)
        pt2(0) = lrc(0) + 25: pt2(1) = llc(1): pt2(2) = llc(2)
        Set lineObj = .AddLine(pt1, pt2)
        lineObj.Update
        
        'Draw upper horizontal line
        pt1(0) = ulc(0) - 25: pt1(1) = ulc(1): pt1(2) = llc(2)
        pt2(0) = urc(0) + 25: pt2(1) = urc(1): pt2(2) = llc(2)
        Set lineObj = .AddLine(pt1, pt2)
        lineObj.Update
        
        'Draw left vertical line
        pt1(0) = llc(0): pt1(1) = llc(1) - 25: pt1(2) = llc(2)
        pt2(0) = ulc(0): pt2(1) = ulc(1) + 25: pt2(2) = llc(2)
        Set lineObj = .AddLine(pt1, pt2)
        lineObj.Update
        
        'Draw right vertical line
        pt1(0) = lrc(0): pt1(1) = lrc(1) - 25: pt1(2) = llc(2)
        pt2(0) = urc(0): pt2(1) = urc(1) + 25: pt2(2) = llc(2)
        Set lineObj = .AddLine(pt1, pt2)
        lineObj.Update
        
        'Draw left fold
        polyPoint(0) = llc(0): polyPoint(1) = llc(1): polyPoint(2) = llc(2)
        polyPoint(3) = llc(0) - 25: polyPoint(4) = llc(1): polyPoint(5) = llc(2)
        polyPoint(6) = ulc(0) - 25: polyPoint(7) = ulc(1): polyPoint(8) = ulc(2)
        polyPoint(9) = ulc(0): polyPoint(10) = ulc(1): polyPoint(11) = ulc(2)
        Set polyObj = .AddPolyline(polyPoint)
        polyObj.Layer = "Green"
        polyObj.Update
        
        'Draw upper fold
        polyPoint(0) = ulc(0): polyPoint(1) = ulc(1): polyPoint(2) = ulc(2)
        polyPoint(3) = ulc(0): polyPoint(4) = ulc(1) + 25: polyPoint(5) = ulc(2)
        polyPoint(6) = urc(0): polyPoint(7) = urc(1) + 25: polyPoint(8) = urc(2)
        polyPoint(9) = urc(0): polyPoint(10) = urc(1): polyPoint(11) = urc(2)
        Set polyObj = .AddPolyline(polyPoint)
        polyObj.Layer = "Green"
        polyObj.Update
        
        'Draw right fold
        polyPoint(0) = urc(0): polyPoint(1) = urc(1): polyPoint(2) = urc(2)
        polyPoint(3) = urc(0) + 25: polyPoint(4) = urc(1): polyPoint(5) = urc(2)
        polyPoint(6) = lrc(0) + 25: polyPoint(7) = lrc(1): polyPoint(8) = lrc(2)
        polyPoint(9) = lrc(0): polyPoint(10) = lrc(1): polyPoint(11) = lrc(2)
        Set polyObj = .AddPolyline(polyPoint)
        polyObj.Layer = "Green"
        polyObj.Update
        
        'Draw lower fold
        polyPoint(0) = lrc(0): polyPoint(1) = lrc(1): polyPoint(2) = lrc(2)
        polyPoint(3) = lrc(0): polyPoint(4) = lrc(1) - 25: polyPoint(5) = lrc(2)
        polyPoint(6) = llc(0): polyPoint(7) = llc(1) - 25: polyPoint(8) = llc(2)
        polyPoint(9) = llc(0): polyPoint(10) = llc(1): polyPoint(11) = llc(2)
        Set polyObj = .AddPolyline(polyPoint)
        polyObj.Layer = "Green"
        polyObj.Update
        
        'Draw upper and lower rivet holes
        For i = 1 To HCount
            pt1(0) = ulc(0) + 25 + (i - 1) * HDistance: pt1(1) = ulc(1) + 15: pt1(2) = ulc(2)
            Set circObj = .AddCircle(pt1, 2.5)
            circObj.Layer = "Rivet"
            circObj.Update
            
            pt1(0) = llc(0) + 25 + (i - 1) * HDistance: pt1(1) = llc(1) - 15: pt1(2) = llc(2)
            Set circObj = .AddCircle(pt1, 2.5)
            circObj.Layer = "Rivet"
            circObj.Update
        Next i
        
        'Draw left and right rivet holes
        For i = 1 To VCount
            pt1(0) = llc(0) - 15: pt1(1) = llc(1) + 25 + (i - 1) * VDistance: pt1(2) = llc(2)
            Set circObj = .AddCircle(pt1, 2.5)
            circObj.Layer = "Rivet"
            circObj.Update
            
            pt1(0) = lrc(0) + 15: pt1(1) = lrc(1) + 25 + (i - 1) * VDistance: pt1(2) = llc(2)
            Set circObj = .AddCircle(pt1, 2.5)
            circObj.Layer = "Rivet"
            circObj.Update
        Next i
        
    End With
    
    Set lineObj = Nothing
    Set polyObj = Nothing
    Set circObj = Nothing
End Function