|
Тема |
Re: трябва да си много богат ... [re: Mинaвaщ] |
|
Автор | пporpaмиcт (Нерегистриран) | |
Публикувано | 03.06.06 14:36 |
|
|
Тук ти пускам едно макросче, което може би ще бъде полезно и за други. Служи за мащабиране на размерите в чертежа. Работи добре за детайли с размери от 10 до към 3000мм. Ако са по-големи или по-малки трябва се настроят обхватите.
За да се види "силата" на макроса трябва да свържеш към иконки двете подпрограми ScaleUp и ScaleDown, ако го стартираш от меню производителността му пада много.
Public Sub ScaleUp()
ChangeDimensions True
End Sub
Public Sub ScaleDown()
ChangeDimensions False
End Sub
Private Function ChangeDimensions(direction As Boolean)
Dim d3p As AcadDim3PointAngular
Dim ddi As AcadDimDiametric
Dim dor As AcadDimOrdinate
Dim dal As AcadDimAligned
Dim dro As AcadDimRotated
Dim dan As AcadDimAngular
Dim dra As AcadDimRadial
Dim ent As AcadEntity
Dim i As Integer, count As Integer
Dim dScale As Double
dScale = ThisDrawing.GetVariable("DIMSCALE")
If direction Then
If dScale < 1 Then
dScale = dScale * 2
Else
dScale = dScale + 1
End If
Else
If dScale > 2 Then
dScale = dScale - 1
Else
dScale = dScale / 2
End If
End If
ThisDrawing.SetVariable "DIMSCALE", dScale
count = ThisDrawing.ModelSpace.count - 1
For i = 0 To count
Set ent = ThisDrawing.ModelSpace.Item(i)
Select Case ent.ObjectName
Case "AcDbRotatedDimension"
Set dro = ent
dro.ScaleFactor = dScale
Case "AcDbAlignedDimension"
Set dal = ent
dal.ScaleFactor = dScale
Case "AcDbRadialDimension"
Set dra = ent
dra.ScaleFactor = dScale
Case "AcDbDiametricDimension"
Set ddi = ent
ddi.ScaleFactor = dScale
Case "AcDbOrdinateDimension"
Set dor = ent
dor.ScaleFactor = dScale
Case "AcDb2LineAngularDimension"
Set dan = ent
dan.ScaleFactor = dScale
End Select
Next
ThisDrawing.Regen True
End Function
|
| |
|
|
|