Przerobienie prostego makra z Autocada na Zwcada - problem


Recommended Posts

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]

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
 Share