Przerobienie prostego makra z Autocada na Zwcada - problem


Rekomendowane odpowiedzi

Witam w autocadzie zrobiłem sobie makro które zlicza sumę pól (fragment):

   ThisDrawing.SelectionSets.Item("ss").Delete
       Set sel = ThisDrawing.SelectionSets.Add("ss")
           sel.SelectOnScreen
           m = sel.Count

   For i = 0 To m - 1
    Set kwadrat = sel.Item(i)
    pole1 = kwadrat.Area
    pole = pole + pole1
    slajd = ThisDrawing.Utility.RealToString(pole, acDecimal, 2)
       Next

Przerobiłem go na wersję zwcada:

   Thisdocument.SelectionSets.Item("ss").Delete
       Set sel = Thisdocument.SelectionSets.Add("ss")
           sel.SelectOnScreen
           m = sel.Count

   For i = -0 To m - 1
    Set kwadrat = sel.Item(i)
    pole1 = kwadrat.Area
    pole = pole + pole1
    slajd = Thisdocument.Utility.RealToString(pole, zcDecimal, 2)
   Next

Wszystko działa, tylko dlaczego wywołanie pole1 = kwadrat.Area zwraca wartość zawsze zero. Tak jakby kwadrat.Area nie było takiego obiektu. Ktoś mi pomoże? Może brakuje jakiejś bibilioteki[/code]

Odnośnik do komentarza
Udostępnij na innych stronach

Sprawdziłem Kod który Pan przesłał na ZWCAD 2012 (ver. 2011.10.30) i obiektach typu poililinia, prostokąt. Wartości zwracane przez program były zgodne z oczekiwanymi, czyli pole zostało poprawnie odczytane. Czy w związku z tym, mógłby Pan przesłać własny rysunek, na którym występuje problem? Proszę również o informację o wersji ZWCADa, na której testował Pan przedstawiony kod. Informację tą uzyskać może Pan po wpisaniu polecenia vernum

Odnośnik do komentarza
Udostępnij na innych stronach

Wersja ZWCADA: 2011.10.30

Testowałem na obiektach typu Polilinia, prostokąt.

W załączniku rysunek, na którym testowałem makro:

Sub si()
Dim pole, pole1 As Double
Dim i, m As Integer
Dim sel As ZwcadSelectionSet
Dim kwadrat As ZwcadEntity
Dim fild As ZwcadText
Dim ip
Dim slajd As String
 On Error Resume Next
  Thisdocument.SelectionSets.Item("ss").Delete
   Set sel = Thisdocument.SelectionSets.Add("ss")
       sel.SelectOnScreen
       m = sel.Count
For i = 0 To m - 1
Set kwadrat = sel.Item(i)
pole1 = kwadrat.Area
pole = pole + pole1
slajd = Thisdocument.Utility.RealToString(pole, zcDecimal, 2)
   Next
MsgBox slajd
ip = Thisdocument.Utility.GetPoint(, "Wstaw")
ip(1) = ip(1) + 0.1
Set fild = Thisdocument.ModelSpace.AddText(slajd, ip, 0.2)
End Sub

rysunek_testowy.dwg

Odnośnik do komentarza
Udostępnij na innych stronach

A tak, to wiele tłumaczy.

1. On Error Resume Next należy używać zawsze w parze z On Error GoTo 0.

Wprowadzenie tej zmiany bardzo ułatwia znalezienie błędu, którym w tym przypadku było pobranie wartości Area z obiektu klasy ZwcadEntity. ZwcadEntity nie ma takie własności, stąd błąd. Rozwiązanie jest proste, trzeba sprawdzić, czy zaznaczony obiekt to Polilinia, i jeśli tak, zrzutować ją na typ ZwcadLWPolyline. wówczas możliwe będzie odczytanie pola powierzchni.

Całość powinna wyglądać tak:

Public Sub si()
   Dim pole, pole1 As Double
   Dim i, m As Integer
   Dim sel As ZwcadSelectionSet
   Dim SelEntity As ZwcadEntity
   Dim kwadrat As ZwcadLWPolyline

   Dim fild As ZwcadText
   Dim ip
   Dim slajd As String
   On Error Resume Next
   Thisdocument.SelectionSets.Item("ss").Delete
   On Error GoTo 0
   Set sel = Thisdocument.SelectionSets.Add("ss")
   sel.SelectOnScreen
   m = sel.Count
   For i = 0 To m - 1
       Set SelEntity = sel.Item(i)
       If SelEntity.EntityType = zcLWPolyline Then
           pole1 = kwadrat.Area
       Else
           pole1 = 0
       End If

       pole = pole + pole1
       slajd = Thisdocument.Utility.RealToString(pole, zcDecimal, 2)
   Next
   MsgBox slajd
   ip = Thisdocument.Utility.GetPoint(, "Wstaw")
   ip(1) = ip(1) + 0.1
   Set fild = Thisdocument.ModelSpace.AddText(slajd, ip, 0.2)
   Thisdocument.Regen (zcActiveViewport)

End Sub

Odnośnik do komentarza
Udostępnij na innych stronach

Dla ZWCAD+ konieczne jest kilka zmian:

1. Zmienione zostały typy obiektów np: ZwcadEntity na ZcadEntity itd

2. ThisDocument zmieniono na ThisDrawing

3. Stałe określające typy obiektów: zcLWPolyline na zcPolylineLight

Public Sub si()
    Dim pole, pole1 As Double
    Dim i, m As Integer
    Dim sel As ZcadSelectionSet
    Dim SelEntity As ZcadEntity
    Dim kwadrat As ZcadLWPolyline

    Dim fild As ZcadText
    Dim ip
    Dim slajd As String
    On Error Resume Next
    Set sel = ThisDrawing.SelectionSets.Item("ss")
    If Not (sel Is Nothing) Then sel.Delete
    On Error GoTo 0
    Set sel = ThisDrawing.SelectionSets.Add("ss")
    sel.SelectOnScreen
    m = sel.Count
    For i = 0 To m - 1
        Set SelEntity = sel.Item(i)
        If SelEntity.EntityType = zcPolylineLight Then
           Set kwadrat = SelEntity
           pole1 = kwadrat.Area
        Else
            pole1 = 0
        End If

        pole = pole + pole1
        slajd = ThisDrawing.Utility.RealToString(pole, zcDecimal, 2)
    Next
    MsgBox slajd
    ip = ThisDrawing.Utility.GetPoint(, "Wstaw")
    ip(1) = ip(1) + 0.1
    Set fild = ThisDrawing.ModelSpace.AddText(slajd, ip, 0.2)
    ThisDrawing.Regen (zcActiveViewport)

End Sub

Proszę jeszcze o podanie vernum programu, który Pan używa.

Odnośnik do komentarza
Udostępnij na innych stronach

Dołącz do dyskusji

Możesz dodać zawartość już teraz a zarejestrować się później. Jeśli posiadasz już konto, zaloguj się aby dodać zawartość za jego pomocą.

Gość
Dodaj odpowiedź do tematu...

×   Wklejono zawartość z formatowaniem.   Usuń formatowanie

  Dozwolonych jest tylko 75 emoji.

×   Odnośnik został automatycznie osadzony.   Przywróć wyświetlanie jako odnośnik

×   Przywrócono poprzednią zawartość.   Wyczyść edytor

×   Nie możesz bezpośrednio wkleić grafiki. Dodaj lub załącz grafiki z adresu URL.

Ładowanie