GoldenLine
Zaloguj się
Jakub Rosiek

Jakub Rosiek Geodeta

Temat: Wymiarowanie powierzchni w microstation

cześć!
Mam w rysunku kilkadziesiąt wypełnionych, zamkniętych pól. Potrzebuje opisać każdą powierzchnię danego pola. Czy da sie jednym kliknięciem wstawić tekst z polem powierzchni. W narzędziach znalazłem jedynie pomiar powierzchni bez możliwości umieszczenia wyświetlonej powierzchni na rysunku :/
Link do wypowiedziLink
Adrian B.

Adrian B. Client Partner -
Professional Web
Platform

Temat: Wymiarowanie powierzchni w microstation

Jeśli korzystasz z XMa lub v8i to masz narzędzie Wstaw pole w edytorze tekstu. Ale wówczas musisz wskazywać każdy element osobno.

Poniżej małe makro, które pozwoli Ci za jednym kliknięciem wstawić w srodku wielokąta powierzchnie z dowolnym opisem:

Sub WstawOpis()
Dim ele As Element
Dim ee As ElementEnumerator
Dim esc As ElementScanCriteria
Dim pow As String
Dim srodek As Point3d

Set esc = New ElementScanCriteria

esc.ExcludeAllLevels
esc.IncludeLevel ActiveDesignFile.Levels("Object2") 'nazwa warstwy na której ma przeprowadzić operacje

Set ee = ActiveModelReference.Scan(esc)
Do While ee.MoveNext
If ee.Current.IsShapeElement Then
pow = ee.Current.AsShapeElement.Area 'przypisanie powierzchni
srodek = ee.Current.AsShapeElement.Centroid 'srodek wielokąta
ElseIf ee.Current.IsComplexShapeElement Then
pow = ee.Current.AsComplexShapeElement.Area 'przypisanie powierzchni
srodek = ee.Current.AsComplexShapeElement.Centroid 'srodek wielokąta
End If
'wstawianie tekstu
Set ele = CreateTextElement1(Nothing, "pole powierzchni: " & pow & "m", srodek, Matrix3dIdentity)
ActiveModelReference.AddElement ele
ele.Redraw
Loop
End Sub
Link do wypowiedziLink
Witold Korab

Witold Korab geodeta, Biprogeo

Temat: Wymiarowanie powierzchni w microstation

Witam
Pomocne makro, tylko powierzcznia jest wyświtlana z dokładnością do 10 miejsc po przecinku, zbyt dokładnie jak dla mnie :) Da się je tak zmianić żeby obliczana powierzchnia była pokazywana z dokładnością do 1 m2?
Link do wypowiedziLink
Karol Stachura

Karol Stachura Nie ma na świecie
rzeczy niemożliwych
- są tylko mało
pra...

Temat: Wymiarowanie powierzchni w microstation

pow = Format( ee.Current.AsShapeElement.Area, "0")
oraz
pow = Format(ee.Current.AsComplexShapeElement.Area, "0")
Link do wypowiedziLink
Witold Korab

Witold Korab geodeta, Biprogeo

Temat: Wymiarowanie powierzchni w microstation

Dzięki
Działa tak jak chciałem.
To jeszcze o jedną rzecz zapytam. Można tak macro zmodyfikować żeby obliczane i wstawiane były pola pow. na aktywnej warstwie?
Żeby uniknąc zmiany nazwy warstwy w macro lub na rysunku.
Link do wypowiedziLink
Karol Stachura

Karol Stachura Nie ma na świecie
rzeczy niemożliwych
- są tylko mało
pra...

Temat: Wymiarowanie powierzchni w microstation

set ee = ActiveModelReference.GetSelectedElements

powinno zadziałać na zaznaczonych elementach co załatwia w jakiś sposób to co opisałeś.

http://docs.bentley.com/product.php?prod=1
na tej stronie masz dokumentacje do vba microstation z przykładami wprawdzie dla wersji 2004 ale dość nieźle z tego co pamiętam napisaną.Karol Stachura edytował(a) ten post dnia 23.10.12 o godzinie 22:29
Link do wypowiedziLink
Adrian B.

Adrian B. Client Partner -
Professional Web
Platform

Temat: Wymiarowanie powierzchni w microstation

set ee = ActiveModelReference.GetSelectedElements

powyższy enumerator zwraca zaznaczone elementy
a w przypadku aktywnej warstwy należy w kodzie jednak zmienić:

esc.IncludeLevel ActiveDesignFile.Levels("Object2")

na:

esc.IncludeLevel ActiveSettings.Level
Link do wypowiedziLink
Karol Stachura

Karol Stachura Nie ma na świecie
rzeczy niemożliwych
- są tylko mało
pra...

Temat: Wymiarowanie powierzchni w microstation

Mała poprawka:

Do While ee.MoveNext
If ee.Current.IsShapeElement Then
pow = ee.Current.AsShapeElement.Area 'przypisanie powierzchni
srodek = ee.Current.AsShapeElement.Centroid 'srodek wielokąta
'wstawianie tekstu
Set ele = CreateTextElement1(Nothing, "pole powierzchni: " & pow & "m", srodek, Matrix3dIdentity)
ActiveModelReference.AddElement ele
ele.Redraw
ElseIf ee.Current.IsComplexShapeElement Then
pow = ee.Current.AsComplexShapeElement.Area 'przypisanie powierzchni
srodek = ee.Current.AsComplexShapeElement.Centroid 'srodek wielokąta
'wstawianie tekstu
Set ele = CreateTextElement1(Nothing, "pole powierzchni: " & pow & "m", srodek, Matrix3dIdentity)
ActiveModelReference.AddElement ele
ele.Redraw
End If
Loop

Patrząc na kod za każdym elementem nie będącym shapem albo complexshape na warstwie będzie się tworzyć na zmiennych pow i srodek kolejny obiekt.
Link do wypowiedziLink
Adrian B.

Adrian B. Client Partner -
Professional Web
Platform

Temat: Wymiarowanie powierzchni w microstation

słuszna uwaga :)

zatem pełny kod powinien wyglądać następująco (dla mniej wtajemniczonych :] ) po małej optymalizacji:

Sub WstawOpis()
Dim ele As Element
Dim ee As ElementEnumerator
Dim esc As ElementScanCriteria
Dim pow As String
Dim srodek As Point3d
Dim znaleziono As Boolean

Set esc = New ElementScanCriteria

esc.ExcludeAllLevels
esc.IncludeLevel ActiveSettings.Level ' aktywna warstwa

Set ee = ActiveModelReference.Scan(esc)
Do While ee.MoveNext
znaleziono = False
If ee.Current.IsShapeElement Then
pow = ee.Current.AsShapeElement.Area 'przypisanie powierzchni
srodek = ee.Current.AsShapeElement.Centroid 'srodek wielokąta
znaleziono = True
ElseIf ee.Current.IsComplexShapeElement Then
pow = ee.Current.AsComplexShapeElement.Area 'przypisanie powierzchni
srodek = ee.Current.AsComplexShapeElement.Centroid 'srodek wielokąta
znaleziono = True
End If
'wstawianie tekstu
If znaleziono Then
Set ele = CreateTextElement1(Nothing, "pole powierzchni: " & pow & "m", srodek, Matrix3dIdentity)
ActiveModelReference.AddElement ele
ele.Redraw
End If
Loop
End SubAdek Baranowski edytował(a) ten post dnia 24.10.12 o godzinie 13:01
Link do wypowiedziLink
Witold Korab

Witold Korab geodeta, Biprogeo

Temat: Wymiarowanie powierzchni w microstation

Dzięki, działa tak jak potrzeba.
Można gdzieś znaleść opis komend, kodów do makr dla mniej wtajemniczonych po polsku?
Link do wypowiedziLink
Wiktor Niezgodziński

Wiktor Niezgodziński Geo Pro3D

Temat: Wymiarowanie powierzchni w microstation

witam,
nie zakładałem nowego tematu, gdy z mój problem wydaje się podobny.
Potrzebuję program, który będzie działać dla zaznaczonego obszaru w microstation (prostokąta).
próbowałem wykonać to na podstawie Waszych programów ale nic z tego.

Private Sub CommandButton1_Click()
Dim elem As Element
Dim enumer As ElementEnumerator
Dim scan As ElementScanCriteria
Dim pt1 As Point3d
Dim pt2 As Point3d
Set scan = New ElementScanCriteria
scan.ExcludeAllLevels
scan.IncludeLevel ActiveSettings.Level
Set enumer = ActiveModelReference.scan(scan)
Do While enumer.MoveNext
znaleziono = False
If enumer.Current.IsShapeElement Then
pt1 = elem.Current.AsShapeElement.StartPoint <-- przy current wyskakuje już błąd...
pt2 = elem.Current.AsShapeElement.EndPoint
znaleziono = True
End If
Dim x1, y1, x2, y2
x1 = pt1.x
y1 = pt1.y
x2 = pt2.x
y2 = pt2.y

End Sub

z góry dziękuje za uwagi
Link do wypowiedziLink
Karol Stachura

Karol Stachura Nie ma na świecie
rzeczy niemożliwych
- są tylko mało
pra...

Temat: Wymiarowanie powierzchni w microstation

Musisz mieć dwa rodzaje enumeratorów, pierwszy będzie przechowywał elementy z warstwy a drugi pobierze zaznaczony obiekt.
Zaznaczony element możesz pobrać jako ActiveModelReference.GetSelectedElements,
jeśli chcesz pobrać współrzędne wierzchołków to do tego jest vertexlist który zapisuje je do arraya - możesz znaleźć przykłady zastosowania tego polecenia w pomocy do vba w linku który podałem powyżej.
Link do wypowiedziLink
Wiktor Niezgodziński

Wiktor Niezgodziński Geo Pro3D

Temat: Wymiarowanie powierzchni w microstation

a jeżeli w danej warstwie będzie tylko ten jeden element to chyba jeden enumeretor? poszperam jeszcze w tych pomocach.
dzieki wielkie
Link do wypowiedziLink
Adrian B.

Adrian B. Client Partner -
Professional Web
Platform

Temat: Wymiarowanie powierzchni w microstation

opisz ciut precyzyjniej co chcesz zrobić.
W Twoim kodzie jest kilka błędów:
Przede wszsytkim endpoint i startpoint nie sa wlaściowściami obiektu shape, dlatego w ten sposób nie wyciągniesz tych punktów. Błąd przy pt1 = elem.Current.AsShapeElement.StartPoint wynika z tego, że powinno być enumer.Current.AsShapeElement a nie elem.Current.AsShapeElement.

Jeśli chcesz przeskanować to co jest w prostokącie to albo kładziesz na niego ogrodzenie albo jeśli zawsze podstawa prostokąta to kąt 0 stopni to możesz przeskanować za pomocą metody IncludeOnlyWithinRange.
Link do wypowiedziLink
Wiktor Niezgodziński

Wiktor Niezgodziński Geo Pro3D

Temat: Wymiarowanie powierzchni w microstation

najlepiej, żeby program sczytywał współrzędne narysowanego prostokąta lub ogrodzenia i żeby mi je gdzieś wyświetlił. ten prostokąt będzie obracany, więc podstawa nie będzie kątem 0 stopni. patrzyłem na przykłady z vertexlistami ale nie znalazłem dokładnie tego o czym tu piszę.
Link do wypowiedziLink
Adrian B.

Adrian B. Client Partner -
Professional Web
Platform

Temat: Wymiarowanie powierzchni w microstation

Sub Cbgff()
Dim elem As Element
Dim enumer As ElementEnumerator
Dim scan As ElementScanCriteria
Dim punkty() As Point3d
Dim pt1 As Point3d
Dim pt2 As Point3d

Set scan = New ElementScanCriteria
scan.ExcludeAllLevels
scan.IncludeLevel ActiveSettings.Level

Set enumer = ActiveModelReference.scan(scan)

Do While enumer.MoveNext

If enumer.Current.IsShapeElement Then
punkty = enumer.Current.AsShapeElement.GetVertices ' punkty - to tablica w kórej zapisane są wszystkie wierzcholki wielokąta
pt1 = punkty(0) 'pierwszy punkt z list wierzcholkow
pt2 = punkty(UBound(punkty)) 'ostatni punkt z list wierzcholkow
'w przypadku wielokątów ostatni punkt zawsze pokrywa się z pierwszym
'dlatego należałoby przyjąć, że pt2 = punkty(UBound(punkty)-1)
End If

Dim x1, y1, x2, y2
x1 = pt1.X
y1 = pt1.Y
x2 = pt2.X
y2 = pt2.Y
Loop
End Sub
Link do wypowiedziLink
Karol Stachura

Karol Stachura Nie ma na świecie
rzeczy niemożliwych
- są tylko mało
pra...

Temat: Wymiarowanie powierzchni w microstation

Kilka uwag formalnych:
dim bez typu zmiennych zżera okrutnie pamięć.
A co się stanie jak pierwszy obiekt nie bedzie shape'm ze zmiennymi x1,x2,y1,y2 ? ;)
Link do wypowiedziLink
Adrian B.

Adrian B. Client Partner -
Professional Web
Platform

Temat: Wymiarowanie powierzchni w microstation

Karol Stachura:
Kilka uwag formalnych:
dim bez typu zmiennych zżera okrutnie pamięć.
A co się stanie jak pierwszy obiekt nie bedzie shape'm ze zmiennymi x1,x2,y1,y2 ? ;)

zgadza się, dobry nawyk to okreslac typ zmiennych.
a x,y warto wrzucic do if'a
Poza tym ten kod to material do nauki ... a jak się uczyć bez błedów :)
Link do wypowiedziLink
Karol Stachura

Karol Stachura Nie ma na świecie
rzeczy niemożliwych
- są tylko mało
pra...

Temat: Wymiarowanie powierzchni w microstation

dobry nawyk to na początek dać option explicit :)
Pozdrawiam,
Link do wypowiedziLink
Wiktor Niezgodziński

Wiktor Niezgodziński Geo Pro3D

Temat: Wymiarowanie powierzchni w microstation

działa tak jak powinno:) dziękuje bardzo
Link do wypowiedziLink
« Wróć do tematów
Odpowiedz

Podobne tematy


Następna dyskusja:

Zapraszam do grupy o Micros...




Wyślij zaproszenie do
Anuluj