Through UserFroms in Autocad I designed the code to draw the polygons, on my laptop it works very well, as soon as I put the same application somewhere else everything works but the drawing becomes only squares or triangles but not the drawing that should be presented.
No one would be able to suggest anything useful without seeing your code, except be pretty sure that your code is wrong.
Norman Yuan
Dear, thank your for your reply, here is my UserForms, when I click button ..., OpenDialog will be show, and open CSV File, after they will be in list as below X, Y and Z:
After Executing, I will have this results as below:
As you can see, completely my Parcel is drawed perfectly, but this application with noone changes, look how this draws:
Everything is differently,
Please below you can see all the sourcecode. Please code is in Event: cmdOpenFile_Click()
Dim Prova As Integer
Dim Points(0 To 100) As Double
Const acLayoutSpace As Integer = 1
Const acModelSpace As Integer = 0
Private Sub cmdEmërtoni_Parcelën_Click()
Dim Nr_i_Parcelës As String
Dim X, Y As Double
Nr = InputBox("Ju lutemi shkruani Numrin e Parcelës", "Numri i Parcelës", "Shkruani Numrin e Parcelës")
X = MesatarjaListbox(lstKord_X)
Y = MesatarjaListbox(lstKord_Y)
Dim mtextObj As AcadMText
Dim insertPoint(0 To 2) As Double
Dim width As Double
Dim textString As String
width = 25
insertPoint(0) = CDbl(X) - 5
insertPoint(1) = CDbl(Y) - 2.5
insertPoint(2) = CDbl(500)
textString = Nr
Set mtextObj = ThisDrawing.ModelSpace.AddMText(insertPoint, width, textString)
End Sub
Private Sub cmdOpenFile_Click()
On Error Resume Next
Dim Filter As String
Dim InitialDir As String
Dim DialogTitle As String
Dim OutputStr As String
Dim Pikat As Integer
Pikat = 1
Filter = "Comma Separated Values (*.csv)" + Chr$(0) + "*.csv" + Chr$(0) + _
"All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
DialogTitle = "Hapja e Dosjes!"
OutputStr = ShowOpen(Filter, "", DialogTitle)
If Len(OutputStr) = 0 Then
txtFilename.Text = "Nuk keni zgjedhur Dosje!"
Else
txtFilename.Text = OutputStr
txtNr_i_Pikave.Text = GetRecordCount(OutputStr) - 1
Dim fileContent As String
Open OutputStr For Input As #1
Do Until EOF(1)
Line Input #1, fileContent
' Vendosni rreshtin e lexuar në TextBox
ListBox1.AddItem fileContent
' Këtu mbushet listat
Dim TextStrng As String
Dim Result() As String
Dim DisplayText As String
TextStrng = fileContent
Result = Split(TextStrng, ",")
For i = LBound(Result()) To UBound(Result())
If i = 0 Then
lstKord_Pika.AddItem Result(i)
LblPika1.Caption = Result(i)
ElseIf i = 1 Then
lstKord_X.AddItem Result(i)
LblPika2.Caption = Result(i)
lstKordinatat.AddItem Result(i)
ElseIf i = 2 Then
lstKord_Y.AddItem Result(i)
LblPika3.Caption = Result(i)
lstKordinatat.AddItem Result(i)
ElseIf i = 3 Then
lstKord_Z.AddItem Result(i)
LblPika4.Caption = Result(i)
' Leximi i rreshtit të parë
lblFillestare_Pika1.Caption = GetFirstItem(lstKord_Pika)
lblFillestare_Pika2.Caption = GetFirstItem(lstKord_X)
lblFillestare_Pika3.Caption = GetFirstItem(lstKord_Y)
lblFillestare_Pika4.Caption = GetFirstItem(lstKord_Z)
lblParaprake_Pika1.Caption = GetPreviousItem(Pikat, lstKord_Pika)
lblParaprake_Pika2.Caption = GetPreviousItem(Pikat, lstKord_X)
lblParaprake_Pika3.Caption = GetPreviousItem(Pikat, lstKord_Y)
lblParaprake_Pika4.Caption = GetPreviousItem(Pikat, lstKord_Z)
Pikat = Pikat + 1
If chckVetëmImporto.Value = False Then
' Vizatimi i Pikave
If chckVizato_Pikat.Value = True Then
Dim pointObj As AcadPoint
Dim location(0 To 2) As Double
location(0) = LblPika2.Caption: location(1) = LblPika3.Caption: location(2) = LblPika4.Caption
Set pointObj = ThisDrawing.ModelSpace.AddPoint(location)
End If
' Vizatimi i rrethit
If chckVizato_Rrathët.Value = True Then
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim circleObj As AcadCircle
centerPoint(0) = CDbl(LblPika2.Caption)
centerPoint(1) = CDbl(LblPika3.Caption)
centerPoint(2) = CDbl(LblPika4.Caption)
radius = 0.2
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
If Not circleObj Is Nothing Then
circleObj.color = acRed
Else
MsgBox "Ndodhi një problem gjatë krijimit të objektit cirkular.", vbExclamation
End If
End If
' Vizatimi i Tekstit
If chckVizato_Përshkrimin.Value = True Then
Dim mtextObj As AcadMText
Dim insertPoint(0 To 2) As Double
Dim width As Double
Dim textString As String
mtextObj.TextHeight = 20#
mtextObj.TextWidth = 20#
insertPoint(0) = CDbl(LblPika2.Caption) + 2.5
insertPoint(1) = CDbl(LblPika3.Caption) - 2.5
insertPoint(2) = CDbl(LblPika4.Caption)
textString = LblPika1.Caption
Set mtextObj = ThisDrawing.ModelSpace.AddMText(insertPoint, width, textString)
End If
End If
End If
Next i
Loop
End If
Close #1
lstKordinatat.AddItem (lblFillestare_Pika2.Caption)
lstKordinatat.AddItem (lblFillestare_Pika3.Caption)
If chckVetëmImporto.Value = False Then
If chckVizato_Parcelën.Value = True Then
VizatoPolyline
End If
End If
cmdEmërtoni_Parcelën_Click
ThisDrawing.SendCommand "_ZOOM E" & vbCr
End Sub
Private Sub Open_File(ByVal FileName As String)
On Error Resume Next
Dim Pikat As Integer
Pikat = 1
Dim OutputStr As String
OutputStr = FileName
If Len(OutputStr) = 0 Then
txtFilename.Text = "Nuk keni zgjedhur Dosje!"
Else
txtFilename.Text = OutputStr
txtNr_i_Pikave.Text = GetRecordCount(OutputStr) - 1
Dim fileContent As String
Open OutputStr For Input As #1
Do Until EOF(1)
Line Input #1, fileContent
' Vendosni rreshtin e lexuar në TextBox
ListBox1.AddItem fileContent
' Këtu mbushet listat
Dim TextStrng As String
Dim Result() As String
Dim DisplayText As String
TextStrng = fileContent
Result = Split(TextStrng, ",")
For i = LBound(Result()) To UBound(Result())
If i = 0 Then
lstKord_Pika.AddItem Result(i)
LblPika1.Caption = Result(i)
ElseIf i = 1 Then
lstKord_X.AddItem Result(i)
LblPika2.Caption = Result(i)
lstKordinatat.AddItem Result(i)
ElseIf i = 2 Then
lstKord_Y.AddItem Result(i)
LblPika3.Caption = Result(i)
lstKordinatat.AddItem Result(i)
ElseIf i = 3 Then
lstKord_Z.AddItem Result(i)
LblPika4.Caption = Result(i)
' Leximi i rreshtit të parë
lblFillestare_Pika1.Caption = GetFirstItem(lstKord_Pika)
lblFillestare_Pika2.Caption = GetFirstItem(lstKord_X)
lblFillestare_Pika3.Caption = GetFirstItem(lstKord_Y)
lblFillestare_Pika4.Caption = GetFirstItem(lstKord_Z)
lblParaprake_Pika1.Caption = GetPreviousItem(Pikat, lstKord_Pika)
lblParaprake_Pika2.Caption = GetPreviousItem(Pikat, lstKord_X)
lblParaprake_Pika3.Caption = GetPreviousItem(Pikat, lstKord_Y)
lblParaprake_Pika4.Caption = GetPreviousItem(Pikat, lstKord_Z)
Pikat = Pikat + 1
If chckVetëmImporto.Value = False Then
' Vizatimi i Pikave
If chckVizato_Pikat.Value = True Then
Dim pointObj As AcadPoint
Dim location(0 To 2) As Double
location(0) = LblPika2.Caption: location(1) = LblPika3.Caption: location(2) = LblPika4.Caption
Set pointObj = ThisDrawing.ModelSpace.AddPoint(location)
End If
' Vizatimi i rrethit
If chckVizato_Rrathët.Value = True Then
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim circleObj As AcadCircle
centerPoint(0) = CDbl(LblPika2.Caption)
centerPoint(1) = CDbl(LblPika3.Caption)
centerPoint(2) = CDbl(LblPika4.Caption)
radius = 0.2
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
If Not circleObj Is Nothing Then
circleObj.color = acRed
Else
MsgBox "Ndodhi një problem gjatë krijimit të objektit cirkular.", vbExclamation
End If
End If
' Vizatimi i Tekstit
If chckVizato_Përshkrimin.Value = True Then
Dim mtextObj As AcadMText
Dim insertPoint(0 To 2) As Double
Dim width As Double
Dim textString As String
mtextObj.TextHeight = 20#
mtextObj.TextWidth = 20#
insertPoint(0) = CDbl(LblPika2.Caption) + 2.5
insertPoint(1) = CDbl(LblPika3.Caption) - 2.5
insertPoint(2) = CDbl(LblPika4.Caption)
textString = LblPika1.Caption
Set mtextObj = ThisDrawing.ModelSpace.AddMText(insertPoint, width, textString)
End If
End If
End If
Next i
Loop
End If
Close #1
lstKordinatat.AddItem (lblFillestare_Pika2.Caption)
lstKordinatat.AddItem (lblFillestare_Pika3.Caption)
If chckVetëmImporto.Value = False Then
If chckVizato_Parcelën.Value = True Then
VizatoPolyline
End If
End If
cmdEmërtoni_Parcelën_Click
ThisDrawing.SendCommand "_ZOOM E" & vbCr
End Sub
Function GetRecordCount(filePath As String) As Long
Dim recordCount As Long
Dim fileContent As String
With CreateObject("Scripting.FileSystemObject")
If .FileExists(filePath) Then
With .OpenTextFile(filePath, 1, False)
fileContent = .ReadAll
.Close
End With
recordCount = UBound(Split(fileContent, vbCrLf)) + 1
Else
MsgBox "File not found: " & filePath, vbExclamation
End If
End With
GetRecordCount = recordCount
End Function
Function GetFirstItem(lstBox As MSForms.listbox) As String
If lstBox.ListCount > 0 Then
GetFirstItem = lstBox.List(0)
Else
GetFirstItem = ""
End If
End Function
Function GetPreviousItem(ByVal Indeksi As Integer, ByVal lstBox As MSForms.listbox) As String
If Indeksi >= 1 And Indeksi <= lstBox.ListCount Then
' Merr vleren nga ListBox dhe shfaq ose përdor ndryshe sipas nevojave
GetPreviousItem = lstBox.List(Indeksi - 1)
Else
' Nese indeksi eshte jashte kufijve, shfaq nje mesazh
GetPreviousItem = "Indeksi i pavlefshëm!"
End If
End Function
Function CreatePoint(X As Double, Y As Double, Z As Double) As Variant
Dim point(0 To 2) As Double
point(0) = X
point(1) = Y
point(2) = Z
CreatePoint = point
End Function
Private Sub cmdParcelëeRe_ImportoCSV_Click()
On Error Resume Next
Dim Filter As String
Dim InitialDir As String
Dim DialogTitle As String
Dim OutputStr As String
Dim Pikat As Integer
Pikat = 1
Filter = "Comma Separated Values (*.csv)" + Chr$(0) + "*.csv" + Chr$(0) + _
"All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
DialogTitle = "Hapja e Dosjes!"
OutputStr = ShowOpen(Filter, "", DialogTitle)
If Len(OutputStr) = 0 Then
lblParcelëeRe_Info.Caption = "Nuk keni Dosje!"
Else
lblParcelëeRe_Info.Caption = OutputStr
Dim fileContent As String
Open OutputStr For Input As #1
Do Until EOF(1)
Line Input #1, fileContent
' Këtu mbushet listat
Dim TextStrng As String
Dim Result() As String
Dim DisplayText As String
TextStrng = fileContent
Result = Split(TextStrng, ",")
For i = LBound(Result()) To UBound(Result())
If i = 0 Then
lstParcelëeRe_Pika.AddItem Result(i)
ElseIf i = 1 Then
lstParcelëeRe_X.AddItem Result(i)
ElseIf i = 2 Then
lstParcelëeRe_Y.AddItem Result(i)
ElseIf i = 3 Then
lstParcelëeRe_Z.AddItem Result(i)
End If
Next i
Loop
End If
Close #1
End Sub
Private Sub cmdParcelëeRe_KrijoNdarje_Click()
' Krijimi i Pikave në dy Skajet e Vijës
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Dim pointObj As AcadPoint
Dim location(0 To 2) As Double
location(0) = Val(CDbl(txtParcelëeRe_X1.Text)): location(1) = Val(CDbl(txtParcelëeRe_Y1.Text)): location(2) = Val(CDbl(txtParcelëeRe_Z1.Text))
Set pointObj = ThisDrawing.ModelSpace.AddPoint(location)
location(0) = Val(CDbl(txtParcelëeRe_X2.Text)): location(1) = Val(CDbl(txtParcelëeRe_Y2.Text)): location(2) = Val(CDbl(txtParcelëeRe_Z2.Text))
Set pointObj = ThisDrawing.ModelSpace.AddPoint(location)
' Vizatimi i rrathëve për të dy pikat
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Dim circleObj As AcadCircle
Dim centerPoint(0 To 2) As Double
Dim radius As Double
centerPoint(0) = Val(CDbl(txtParcelëeRe_X1.Text)): centerPoint(1) = Val(CDbl(txtParcelëeRe_Y1.Text)): centerPoint(2) = Val(CDbl(txtParcelëeRe_Z1.Text))
radius = 0.2
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
If Not circleObj Is Nothing Then
circleObj.color = acRed
Else
MsgBox "Ndodhi një problem gjatë krijimit të objektit cirkular.", vbExclamation
End If
centerPoint(0) = Val(CDbl(txtParcelëeRe_X2.Text)): centerPoint(1) = Val(CDbl(txtParcelëeRe_Y2.Text)): centerPoint(2) = Val(CDbl(txtParcelëeRe_Z2.Text))
radius = 0.2
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
If Not circleObj Is Nothing Then
circleObj.color = acRed
Else
MsgBox "Ndodhi një problem gjatë krijimit të objektit cirkular.", vbExclamation
End If
'Vizatimi i tekstit
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Dim mtextObj As AcadMText
Dim insertPoint(0 To 2) As Double
Dim width As Double
Dim textString As String
insertPoint(0) = CDbl(txtParcelëeRe_X1.Text) + 2.5: insertPoint(1) = CDbl(txtParcelëeRe_Y1.Text) - 2.5: insertPoint(2) = CDbl(txtParcelëeRe_Z1.Text)
textString = txtParcelëeRe_Pika1.Text
Set mtextObj = ThisDrawing.ModelSpace.AddMText(insertPoint, width, textString)
insertPoint(0) = CDbl(txtParcelëeRe_X2.Text) + 2.5: insertPoint(1) = CDbl(txtParcelëeRe_Y2.Text) - 2.5: insertPoint(2) = CDbl(txtParcelëeRe_Z2.Text)
textString = txtParcelëeRe_Pika2.Text
Set mtextObj = ThisDrawing.ModelSpace.AddMText(insertPoint, width, textString)
ThisDrawing.SendCommand "_ZOOM E" & vbCr
ThisDrawing.Regen acActiveViewport
End Sub
Private Sub cmdParcelëeRe_Pastro_Click()
lstParcelëeRe_Pika.Clear
lstParcelëeRe_X.Clear
lstParcelëeRe_Y.Clear
lstParcelëeRe_Z.Clear
End Sub
Private Sub cmdParcelëeRe_PastroPikat_Click()
txtParcelëeRe_Pika1.Text = ""
txtParcelëeRe_X1.Text = ""
txtParcelëeRe_Y1.Text = ""
txtParcelëeRe_Z1.Text = ""
txtParcelëeRe_Pika2.Text = ""
txtParcelëeRe_X2.Text = ""
txtParcelëeRe_Y2.Text = ""
txtParcelëeRe_Z2.Text = ""
End Sub
Private Sub cmdParcelëeRe_ShtoManualisht_Click()
Dim Përgjigjja As String
Përgjigjja = InputBox("Ju lutemi jepni emrine pikës pët t'u futur në Tabelë!", "Emri i Pikës", "Shkruani këtu!")
lstParcelëeRe_Pika.AddItem Përgjigjja
Përgjigjja = InputBox("Ju lutemi jepni kordinatën X të pikës pët t'u futur në Tabelë!", "Kordinata X", "Shkruani këtu!")
lstParcelëeRe_X.AddItem Përgjigjja
Përgjigjja = InputBox("Ju lutemi jepni kordinatën Y të pikës pët t'u futur në Tabelë!", "Kordinata Y", "Shkruani këtu!")
lstParcelëeRe_Y.AddItem Përgjigjja
Përgjigjja = InputBox("Ju lutemi jepni kordinatën Z të pikës pët t'u futur në Tabelë!", "Kordinata Z", "Shkruani këtu!")
lstParcelëeRe_Z.AddItem Përgjigjja
End Sub
Private Sub cmdPaste_Data_Click()
' Split the text on spaces and insert each word on a new line with row numbers
Dim inputText As String
Dim words() As String
Dim i As Integer
Dim rowNumber As Integer
' Get the text from the multiline textbox
inputText = Me.txtMultilineText.Value
' Split the text into an array of words
words = Split(inputText, " ")
' Clear the existing text in the textbox
Me.txtMultilineText.Value = ""
' Initialize row number
rowNumber = 1
' Insert each word on a new line with row numbers
For i = LBound(words) To UBound(words)
Me.txtMultilineText.Value = Me.txtMultilineText.Value & rowNumber & "," & words(i) & ",500" & vbCrLf
rowNumber = rowNumber + 1
Next i
Fshier_Rreshtin_e_Fundit
' Save the content of the MultiLineTextBox as a CSV file on the desktop
Dim filePath As String
Dim fileNumber As Integer
' Get the desktop path
filePath = Environ("USERPROFILE") & "\Desktop\Parcela.csv"
' Open a new file for writing
fileNumber = FreeFile
Open filePath For Output As fileNumber
' Write the content of the MultiLineTextBox to the file
Print #fileNumber, Replace(Me.txtMultilineText.Value, vbCrLf, vbNewLine)
' Close the file
Close fileNumber
Open_File filePath
MsgBox "Dizajni është krijuar!" & vbNewLine & "Mbylleni aplikacionin!", vbInformation
End Sub
Private Sub Fshier_Rreshtin_e_Fundit()
Dim linesArray() As String
Dim newContent As String
Dim i As Integer
' Split the lines of the textbox content into an array
linesArray = Split(txtMultilineText.Value, vbCrLf)
' Check if there are at least two lines to delete
If UBound(linesArray) >= 1 Then
' Rebuild the content without the last two lines
For i = 0 To UBound(linesArray) - 2
newContent = newContent & linesArray(i) & vbCrLf
Next i
' Update the textbox content
txtMultilineText.Value = newContent
End If
End Sub
Private Sub lstKord_Pika_Click()
Dim Nr As Integer
Dim X As String
Dim Y As String
Dim Z As String
Dim PikaPërNdarje As String
Nr = lstKord_Pika.ListIndex
X = CStr(lstKord_X.List(Nr))
Y = CStr(lstKord_Y.List(Nr))
Z = CStr(lstKord_Z.List(Nr))
PikaPërNdarje = CStr(lstKord_Pika.List(Nr))
txtAktuale_X.Text = X
txtAktuale_Y.Text = Y
txtAktuale_Z.Text = Z
txtNdarje_Pika_e_Re.Text = PikaPërNdarje
End Sub
Private Sub lstKord_Pika_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If Len(txtNdarje_X1.Text) = 0 Then
txtNdarje_X1.Text = txtAktuale_X.Text
txtNdarje_Y1.Text = txtAktuale_Y.Text
Else
txtNdarje_X2.Text = txtAktuale_X.Text
txtNdarje_Y2.Text = txtAktuale_Y.Text
txtNdarje_Z.Text = txtAktuale_Z.Text
End If
End Sub
Private Sub lstParcelëeRe_Pika_Click()
Dim Nr As Integer
Nr = lstParcelëeRe_Pika.ListIndex
lstParcelëeRe_X.ListIndex = Nr
lstParcelëeRe_Y.ListIndex = Nr
lstParcelëeRe_Z.ListIndex = Nr
End Sub
Private Sub lstParcelëeRe_Pika_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Nr As Integer
Nr = lstParcelëeRe_Pika.ListIndex
If Len(txtParcelëeRe_Pika1.Text) = 0 Then
txtParcelëeRe_Pika1.Text = lstParcelëeRe_Pika.List(Nr)
txtParcelëeRe_X1.Text = lstParcelëeRe_X.List(Nr)
txtParcelëeRe_Y1.Text = lstParcelëeRe_Y.List(Nr)
txtParcelëeRe_Z1.Text = lstParcelëeRe_Z.List(Nr)
Else
txtParcelëeRe_Pika2.Text = lstParcelëeRe_Pika.List(Nr)
txtParcelëeRe_X2.Text = lstParcelëeRe_X.List(Nr)
txtParcelëeRe_Y2.Text = lstParcelëeRe_Y.List(Nr)
txtParcelëeRe_Z2.Text = lstParcelëeRe_Z.List(Nr)
End If
End Sub
Private Sub UserForm_Activate()
Me.top = 50
Me.Left = 800
End Sub
Sub VizatoPolyline()
Dim plineObj As AcadLWPolyline
Dim ArraySize As Integer
ArraySize = lstKordinatat.ListCount - 1
Dim e As Integer
' Deklaroni vargun duke përdorur ReDim për ta përshtatur madhësinë
Dim Points() As Double
ReDim Points(0 To ArraySize)
For e = 0 To ArraySize
Points(e) = lstKordinatat.List(e)
Next e
' Create a lightweight Polyline object in model space
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)
plineObj.Closed = True
plineObj.ZoomExtents
End Sub
Sub VizatoNdarjen()
' Vizatimi i Pikave
Dim pointObj As AcadPoint
Dim location(0 To 2) As Double
location(0) = txtNdarje_X1.Text: location(1) = txtNdarje_X1.Text: location(2) = txtNdarje_Z.Text
Set pointObj = ThisDrawing.ModelSpace.AddPoint(location)
' Vizatimi i rrethit
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim circleObj As AcadCircle
centerPoint(0) = CDbl(txtNdarje_X1.Text)
centerPoint(1) = CDbl(txtNdarje_Y1.Text)
centerPoint(2) = CDbl(txtNdarje_Z.Text)
radius = 0.2
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
If Not circleObj Is Nothing Then
circleObj.color = acRed
Else
MsgBox "Ndodhi një problem gjatë krijimit të objektit cirkular.", vbExclamation
End If
' Vizatimi i Tekstit
Dim mtextObj As AcadMText
Dim insertPoint(0 To 2) As Double
Dim width As Double
Dim textString As String
insertPoint(0) = CDbl(txtNdarje_X1.Text) + 2.5
insertPoint(1) = CDbl(txtNdarje_X2.Text) - 2.5
insertPoint(2) = CDbl(txtNdarje_Z.Text)
textString = txtNdarje_Pika_e_Re.Text
Set mtextObj = ThisDrawing.ModelSpace.AddMText(insertPoint, width, textString)
' Vizatimi i ndarjes
Dim plineObj As AcadLWPolyline
Dim ArraySize As Integer
ArraySize = lstKordinatat.ListCount - 1
Dim e As Integer
' Declare the array using ReDim to match the size
Dim Points() As Double
ReDim Points(0 To 3)
Points(0) = CDbl(txtNdarje_X1.Text)
Points(1) = CDbl(txtNdarje_Y1.Text)
Points(2) = CDbl(txtNdarje_X2.Text)
Points(3) = CDbl(txtNdarje_Y2.Text)
' Create a lightweight Polyline object in model space
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)
' Set the color of the polyline to red
plineObj.color = acRed
plineObj.Closed = True
End Sub
Function MesatarjaListbox(listbox As MSForms.listbox) As Double
Dim total As Double
Dim count As Integer
If listbox.ListCount > 0 Then
For i = 0 To listbox.ListCount - 1
total = total + CDbl(listbox.List(i))
count = count + 1
Next i
If count > 0 Then
MesatarjaListbox = total / count
Else
MsgBox "Listbox është bosh."
End If
Else
MsgBox "Listbox është bosh."
End If
End Function
Anyway thanks a lot for your support!
*Moderator edit* Please post your code in a code window.
The code by itself is not really helpful because we can't test it. Please provide a complete solution. You can't post a dvb to the forum, but you can post a zip or dwg. Try embedding the project in a dwg and then post is with a sample csv.
Sorry, there is no attachment. You may need to zip the file.
Unfortunately, I don't have access to a program that can decompress a rar file. Can you use Windows>Send To>Compressed (zip) Folder to compress the files. Remember to include a sample csv of your data.
Thanks @norman.yuan , but I'm still on win10.
Testing to see if you can attach a dwg with an embedded project.
***It works. @berat_sinani You can just embed your project in a sample dwg using the VBAMAN command.
Dear,
Please find attached ZIP File also is csv file included, thanks a lot, there is no error or bug, but the final in my origin laptop where i have programming this draws me this and everything works perfect as below:
But, when same application I am copying to another pc where also is AutoCad 2006 and i am executing this, i have this drawing as below:
So, the code does not give me any error, but the drawing is not what it should be, but only straight lines and not the plot that should be according to the coordinates.
2006 has a problem? What's the version of AutoCAD where the code runs correctly?
Dear,
If I try it in AutoCad 2006 on my laptop it works perfectly as you can see, only when I change it to another computer it doesn't make the drawing, that is the same version of autocad.
I have tried it on several computers and this exact problem occurs on every computer
Is your version of AutoCAD 2006 a 32 bit version or 64 bit version?
I'm unable to figure out the program flow because there are so many steps and I can't read your language.
Dear,
Please find this video
So, please also find all files Modules, Forms, CSV files to see what you can do!?
I had to modify the csv import to get it to work for me, but it drew the parcel correctly. I would have to spend more time looking over the code to debug it. But it has to be some variable that doesn't exist on the other pc's. It would help if you provided some of their specifications, e.g. AutoCAD version, Windows version, pc specs, and anything else that might be different from your pc. You can run the lisp below to export all the AutoCAD system variables. Run it on your pc and theirs and upload both files. It is actually a command macro you can add to your cui.
^C^C(if (null vars2scr)(load "acadinfo"));vars2scr
Same locale? Language?
same windows decimal separator?