Insert Raster image-VBA-AutoCAD-Help

Insert Raster image-VBA-AutoCAD-Help

Ray-Sync
Advocate Advocate
857 Views
4 Replies
Message 1 of 5

Insert Raster image-VBA-AutoCAD-Help

Ray-Sync
Advocate
Advocate

Hi. I have this code:

 

Private Sub CommandButton1_Click()
Dim imgInsertionPoint(0 To 2) As Double
    Dim img As AcadRasterImage
    Dim xmlDoc As MSXML2.DOMDocument60
    Dim xmlHttp As MSXML2.XMLHTTP60
    Dim fso As New FileSystemObject
    Dim folderPath As String, filePath As String, imageUrl As String
    Dim Lat As Double, lng As Double
    
    imgInsertionPoint(0) = 0: imgInsertionPoint(1) = 0: imgInsertionPoint(2) = 0
    
    ' Pedir al usuario las coordenadas de latitud y longitud
    Lat = -6.323831:    lng = -51.14445
    
    ' Descargar imagen del mapa en línea
    Set xmlDoc = New MSXML2.DOMDocument60
    Set xmlHttp = New MSXML2.XMLHTTP60
    xmlHttp.Open "GET", "http://maps.google.com/maps/api/staticmap?center=" & Lat & "," & lng & "&zoom=16&size=640x480&maptype=satellite&sensor=false", False
    xmlHttp.send
    xmlDoc.LoadXML xmlHttp.responseText
    
    ' Crear carpeta temporal
    folderPath = "C:\Users\PC\Desktop\Temp\"
    If Not fso.FolderExists(folderPath) Then
        fso.CreateFolder folderPath
    End If

    ' Guardar imagen en carpeta temporal

    filePath = folderPath & "imagen.png"
    Dim outputStream As Object
    Set outputStream = CreateObject("ADODB.Stream")
    outputStream.Type = 1 ' Tipo binario
    outputStream.Open
    outputStream.Write xmlHttp.responseBody
    outputStream.SaveToFile filePath, 2 ' 2 = ADODB.StreamSaveMode.adSaveCreateOverWrite

    ' Insertar imagen en AutoCAD
    Set img = ThisDrawing.ModelSpace.AddRaster(filePath, imgInsertionPoint, 1, 0)
 MsgBox "listo"
 End Sub

 

but "filepath" is a invalid input. Can you help me?

jefferson
0 Likes
858 Views
4 Replies
Replies (4)
Message 2 of 5

norman.yuan
Mentor
Mentor

Have you verified the image was indeed downloaded and saved correctly? You should do this check in your code right before the insertion:

If fso.FileExists(filePath) Then
Set img=ThisDrawing.ModelSpace.AddRaster(....)
Else
MsgBox "Image file is not available!"
End Of

Norman Yuan

Drive CAD With Code

EESignature

0 Likes
Message 3 of 5

Ray-Sync
Advocate
Advocate
"Hello everyone,

Firstly, I want to thank Norman.yuan for responding to my question. I posted in an online group asking for help with some code that downloads an image and saves it to a folder. However, when I try to open the image, I can't see the picture in my image viewer.

I'm not sure where I went wrong with the code, but I have three possible explanations:

The URL might not be working properly.
The image may have been downloaded in a format that is not compatible with my image viewer.
I might need to create an API in Google to access the images.
Could anyone please help me figure out what the issue might be? Thank you in advance for your help!"
jefferson
0 Likes
Message 4 of 5

norman.yuan
Mentor
Mentor

Well, it looks to me that you need to pass your authentication information with the http request (username/password, or account key). That is, you need to have an user account with Google MAP API services. 

 

So, the issue is really not related to AutoCAD VBA. Also, it is unfortunate that the technology of accessing HTTP services has advanced significantly while VBA is stuck with very out-of-date technology in this regards (that is, you have to use MSXML for this). Regardless, Google MAP API's requirement of  http request passing in authentication information is the issue here.

Norman Yuan

Drive CAD With Code

EESignature

0 Likes
Message 5 of 5

Ray-Sync
Advocate
Advocate

"Hello @norman.yuan , I wanted to apologize for my late response to your comment. I also wanted to let you know that I have managed to insert free Google images into AutoCAD, but unfortunately, they are not satellite images as I was hoping for. I hope this message finds you well.

This is the code:

Private Sub CommandButton1_Click()
    Dim imgInsertionPoint(0 To 2) As Double
    Dim img As AcadRasterImage
    Dim fso As New FileSystemObject
    Dim folderPath As String, filePath As String, imageUrl As String
    Dim Lat As Double, lng As Double
    Dim pi As Double
pi = 3.14159265358979

    imgInsertionPoint(0) = 0: imgInsertionPoint(1) = 0: imgInsertionPoint(2) = 0
    
    ' Pedir al usuario las coordenadas de latitud y longitud
    Lat = -6.323831:    lng = -51.14445
    
    ' Construir la URL de la imagen de OpenStreetMap
    imageUrl = "https://a.tile.openstreetmap.org/" & GetTileNumber(Lat, lng, 16) & ".png"
    
    ' Crear carpeta temporal
    folderPath = "C:\Users\PC\Desktop\Temp\"
    If Not fso.FolderExists(folderPath) Then
        fso.CreateFolder folderPath
    End If

    ' Descargar imagen y guardarla en carpeta temporal
    filePath = folderPath & "imagen.png"
    DownloadFile imageUrl, filePath
    
    ' Insertar imagen en AutoCAD
    Set img = ThisDrawing.ModelSpace.AddRaster(filePath, imgInsertionPoint, 1, 0)

    MsgBox "¡Listo!"

End Sub

Private Sub DownloadFile(url As String, filePath As String)
    Dim http As Object, stream As Object
    
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Open "GET", url, False
    http.send

    Set stream = CreateObject("ADODB.Stream")
    stream.Open
    stream.Type = 1 ' Tipo binario
    stream.Write http.responseBody
    stream.SaveToFile filePath, 2 ' 2 = ADODB.StreamSaveMode.adSaveCreateOverWrite
    stream.Close
End Sub

Private Function GetTileNumber(ByVal lat As Double, ByVal lng As Double, ByVal zoom As Integer) As String
    Dim xtile As Long, ytile As Long
    xtile = CLng(Int((lng + 180#) / 360# * 2 ^ zoom))
    ytile = CLng(Int((1# - Log(Tan(lat * pi / 180#) + 1# / Cos(lat * pi / 180#)) / pi) / 2# * 2 ^ zoom))
    GetTileNumber = zoom & "/" & xtile & "/" & ytile
End Function
jefferson
0 Likes