Sylwester Paluch

Sylwester Paluch geodeta, geodeta
górniczy

Temat: wymiarowanie wielu lini w XM

Witam.
Mam problem ze znalezieniem odpowiedzi na pytanie w jaki sposób zwymiarować wiele lini. Chodzi o użycie np funkcji fence i zwymiarowniu zawartości przy użyciu Dimension Element.
Może też być zwymiarowanie całej zawartości warstwy.
Kolejne pytanie to czy przy wymiarowaniu dało by się zaokrądlić wymiary do 5cm - np wymiar 1,03 ma być z automatu 1,05.
Jak ustawić styl wymiarowania aby można było zwymiarować linię na linii - jak dam wymiarowanie to zawsze muszę odsunąć wymiar od wymiarowanej linii - nie mogę się do nie dosnapować.
Adrian B.

Adrian B. Client Partner -
Professional Web
Platform

Temat: wymiarowanie wielu lini w XM

Tak na szybko nagrane makro z małą przeróbką.
Musisz sobie zmienić w nim nazwe warstwy.
Nie zaokrągla wymiaru do 0,5 bo z tym troche zabawy :)
Acha chodzi ono pod v8i, wiec nie wiem czy pojdzie pod XM

Sub Wymiarowanie()
Dim ee As ElementEnumerator
Dim esc As New ElementScanCriteria
Dim pntProjected As Point3d
Dim pntStart As Point3d

esc.ExcludeAllLevels
esc.IncludeLevel ActiveModelReference.Levels.Find("nazwa_warstwy") 'tu podajesz nazwę warstwy

Set ee = ActiveModelReference.Scan(esc)
Do While ee.MoveNext
If ee.Current.IsGraphical Then
If ee.Current.IsLineElement Then
Dim startPoint As Point3d
Dim point As Point3d, point2 As Point3d
Dim lngTemp As Long

' Wyślij polecenie
CadInputQueue.SendCommand "DIMCREATE LINEAR"
CadInputQueue.SendKeyin "DIMCREATE LINEAR MODE SIZE"
SetCExpressionValue "dimDialogInfo.iUseDimOffset", -1, "DIMCREATE"
CadInputQueue.SendCommand "DIMENSION AXIS"
CadInputQueue.SendCommand "DIMENSION PLACEMENT"


For i = 1 To ee.Current.AsLineElement.VerticesCount - 1
startPoint = ee.Current.AsLineElement.Vertex(i)

' Wyślij punkt danych do bieżącego polecenia
point.X = startPoint.X
point.Y = startPoint.Y
point.Z = startPoint.Z
CadInputQueue.SendDataPoint point, 1

point = ee.Current.AsLineElement.Vertex(i + 1)

CadInputQueue.SendDataPoint point, 1

point.X = startPoint.X + 1
point.Y = startPoint.Y - 1
point.Z = startPoint.Z
CadInputQueue.SendDataPoint point, 1

' Wyślij przywrócenie do bieżącego polecenia
CadInputQueue.SendReset

CadInputQueue.SendKeyin "DIMCREATE LINEAR MODE SIZE"
Next i


End If
End If

Loop

konto usunięte

Temat: wymiarowanie wielu lini w XM

A można prosić o takie Makro ale dla wersji angielskiej ?
Adrian B.

Adrian B. Client Partner -
Professional Web
Platform

Temat: wymiarowanie wielu lini w XM

nie ma znaczenia wersja jezykowa

Następna dyskusja:

Rzutnie i style lini




Wyślij zaproszenie do