VBA GetObject doesn't get all lines?

VBA GetObject doesn't get all lines?

Anonymous
Not applicable
2,972 Views
8 Replies
Message 1 of 9

VBA GetObject doesn't get all lines?

Anonymous
Not applicable

I have code below that contains the issue, and an image that shows the difference. The red/orange objects I have drawn, the grey ones have been imported. Why does the code only apply to the drawn lines, and how can I make it apply to ALL lines? 

 

  Set objApp = GetObject(, "AutoCAD.Application")
    Set objDoc = objApp.ActiveDocument
    Dim ang As Double
    For Each Obj In objDoc.ModelSpace
        On Error Resume Next
        ang = Obj.Angle
        ang = Round(ang * 180 / pi, 0)
        If Err.Number <> 0 Then
            Err.Clear
            GoTo jump_nextObj
        End If
        Obj.Select
        Debug.Print ang * 180 / pi
        'If Obj.Length > 480 And ang * 180 / pi = 0 Then
        If Obj.Length > 10 Then
            If ang = 0 Or ang = 90 Or ang = 270 Then
                Obj.Color = 1
            End If
        End If

Red = Drawn; Grey = ImportedRed = Drawn; Grey = Imported

0 Likes
Accepted solutions (1)
2,973 Views
8 Replies
Replies (8)
Message 2 of 9

norman.yuan
Mentor
Mentor

I am sure you know this forum is about AutoCAD VBA. Since you use GetObject(, "AutoCAD.Application"), I assume your code DOES NOT run inside AutoCAD VBA, rather, from other application, such as Excel, right? If so, in the other application (i.e. Excel) VBA, did you add reference to AutoCAD type library? If not, then you are doing "late binding", which would your code more prone to syntext error, because those error would only be caught at runtime, not by compiling the code (VBA menu->Debug->Compile [project]). Also, because of the late binding, the "On Error Resume Next" becomes abused: this line

 

obj.Select

 

is completely wrong. No AcadEntity in AutuoCAD document has method "Select()", except for AcadTable, which requires arguments being passed in to its Select() method. But since you have "On Error Resume Next", this line of obvious wrong code got away. The same/similar case, like "Obj.Angle", "Obj.Length", would also cause error, because not all AcadEntity has property "Angle" and/or "Length". If you want to use "On Error Resume Next" to handle possible error, the code to test whether err.Number<>0 SHOULD BE RIGHT AFTER the line that could raise error (i.e. the line where Obj.Angle/Obj.Length is called).

 

These are the reasons your code skip some lines. By the way, are you sure the other lines (grey ones) are AcadLine, not polyline (AcadLWPolyline)?

 

If your target entity is AcadLine, you need to test its Type (early binding, with Acad type library referenced), or test its ObjectName (so you can get rid of crappy "On Error Resume Next" and guessing where error could be raised). Something like:

 

Late binding:

 

Dim obj As Object

For Each Obj in objDoc.ModelSpace

  If UCase(Obj.ObjectName)="ACDBLINE" Then

    '' Now you know the object is AcadLine and has "Angle" and "Length" property

    '' Do what ever...

  End If

Next

 

Early binding

 

Dim ent As AcadEntity

For Each ent In ObjDoc.ModelSpace

  If TypeOf ent Is AcadLine Then

     '' This is AcadLine, go ahead do whatever

  End If

Next

 

 

Norman Yuan

Drive CAD With Code

EESignature

Message 3 of 9

Anonymous
Not applicable

I am not coding in ExcelVBA, it's all in AutoCAD. The grey lines shouldn't be polylines, their endpoints don't connect. If they are polylines, should I explode them and reassign the AcadLine object to then be able to check for angle and length properties? I'll give your solution a shot, assuming the example you gave should also work in CAD VBA (which is again what I'm using). 

0 Likes
Message 4 of 9

norman.yuan
Mentor
Mentor

If you ARE USING AutoCAD VBA, then:

 

1. Why use GetObject(,"Application")? You have AcadApplication object right there available in AutoCAD VBA.

2. Why "late binding" (i.e. declare/use varaible as "Object", rather than specific type, such AcadEntity/AcadLine...

3. Why you need to grab objApp.ActiveDocument? You have built-in "ThisDrawing" right there!

 

So, your code should be like

 

Dim ent As AcadEntity

Dim line As AcadLine

For Each ent In ThisDrawing.Document

  If TypeOf ent Is AcadLine Then

    Set line = ent

    '' then you can use Line.Angle/Line.Length for code that follows

  End If

Next

 

Norman Yuan

Drive CAD With Code

EESignature

0 Likes
Message 5 of 9

Anonymous
Not applicable

Thanks, this is an alternate solution, but it still only applies to items that I have drawn. There was also a runtime error when i ran your modified code, on the .document function. I changed .document to .ModelSpace and it worked, but still not with the longer grey lines. 

 

Dim Ent As AcadEntity
    Dim Line As AcadLine
    
    For Each Ent In ThisDrawing.ModelSpace 'This is where your code threw an error
        If TypeOf Ent Is AcadLine Then
            Set Line = Ent
            Ang = Line.Angle
            Debug.Print "First Ang: " & Ang
            Ang = Ang * 180 / Pi
            Debug.Print "Second Ang: " & Ang
            If Line.Length > 10 Then
                If Ang = 0 Or Ang = 90 Or Ang = 180 Or Ang = 270 Then
                    Line.TrueColor = Color_Orange
                End If
            End If
        End If
    Next Ent
0 Likes
Message 6 of 9

norman.yuan
Mentor
Mentor

yeah, ".document" was typo.

 

As for still not able to pick up the "grey lines", it is obvious that those "grey lines" are not individual AcadLine entities in ModelSpace. Are you sure they are AcadLines? You should be able to tell what type of entity they are by click them and look at the Properties window (or Quick Property window).

 

Norman Yuan

Drive CAD With Code

EESignature

Message 7 of 9

Anonymous
Not applicable

All appear to be polylines, all their lengths are greater than 10, why wouldn't vba read those objects in? 

 

Drawn line propertiesDrawn line propertiesImported line propertiesImported line properties

0 Likes
Message 8 of 9

norman.yuan
Mentor
Mentor

It is NOT "VBA would not read...". It is the code you originally asked (AcadLine with property "Angle") ONLY do something if the entity is AcadLine with this line of code:

 

If TypeOf ent Is AcadLine Then

   '' ONLY AcadLine being processed here

End If

 

If you want process all other kinds of entities, such as polyline (AcadLWPolyline), or circle (AcadCircle), or arc (AcadArc), or whatever, you need to change the code accordingly, and you must be aware, NOT all entities have property "Angle".

 

No offense, but it seems that you need to study/learn a bit more on using AutoCAD to know the differences between line, polyline (and others. like circle, arc, point...) before you can correctly define your VBA's logic.

 

 

Norman Yuan

Drive CAD With Code

EESignature

0 Likes
Message 9 of 9

Anonymous
Not applicable
Accepted solution

I FIGURED IT OUT! You were right, not AcadLines. Here is my finalized code, and posts I found that nudged me in the right direction. The linetypes were Lightweight Polylines. So I grabbed the AcadLWPolyLines, exploded each into a collection of objects, checked each object for AcadLine type, assigned it, and THEN checked angle, length, and performed my operation (color change). Very helpful, especially when importing lines of unknown type from vector PDF. 

 

Helper source 1: https://forums.autodesk.com/t5/civil-3d-forum/get-polyline-coordinates-in-vba/td-p/2451913

Helper source 2: https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2016/ENU/AutoCAD-ActiveX/files...

 

    Dim Ent As AcadEntity
    Dim Line As AcadLine
    Dim PLine As AcadPolyline
    Dim LWPline As AcadLWPolyline
    Dim i As Long, j As Long, k As Long
    i = 0
    j = 0
    k = 0
    
    Dim explodedCol As Variant
    
    For Each Ent In ThisDrawing.ModelSpace
        If TypeOf Ent Is AcadLWPolyline Then
            Set LWPline = Ent
            explodedCol = LWPline.Explode
            For j = 0 To UBound(explodedCol)
                explodedCol(j).Update
                If TypeOf explodedCol(j) Is AcadLine Then
                    Set Line = explodedCol(j)
                    Ang = Line.Angle
                    Ang = Round(Ang * 180 / Pi, 0)
                    If Line.Length > 44 * 12 Then
                        If Ang = 0 Or Ang = 90 Or Ang = 180 Or Ang = 270 Then
                            'Line.TrueColor = Color_Orange
                            'Line.Update
                            Line.Color = acWhite
                        End If
                    End If
                    'Debug.Print "Line found - PL#" & i & ", L#" & j
                End If
            Next j
            Debug.Print i
            i = i + 1
        End If
    Next Ent 

 

0 Likes