трябва ми нещо, което да смята общата дължина на селектираните polylines. пробвах да ти вадя с list, но хистори-то е много малко.
идеална работа ще свърши и нещо, което само да принтира дължината на всеки обект (оттам копи/пейст и...)
едит: натворих нещо. комбинирах 2 примера на vba, дето си вървят с аутокада (вер 2004). сега праща в excel дължините. ето го нещото:
Private Sub cmdStart_Click()
Dim Excel As Object
Dim elem As Object
Dim excelSheet As Object
Dim Array1 As Variant
Dim Count, RowNum As Integer
Dim NumberOfAttributes As Integer
' Start Excel
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set Excel = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Could not load Excel.", vbExclamation
End
End If
End If
On Error GoTo 0
Excel.Visible = True
Excel.Workbooks.Add
Excel.Sheets("Sheet1").Select
Set excelSheet = Excel.ActiveWorkbook.Sheets("Sheet1")
RowNum = 1
Dim Header As Boolean
For Each elem In ThisDrawing.ModelSpace
If StrComp(elem.EntityName, "AcDbPolyline", 1) = 0 Then
RowNum = RowNum + 1
excelSheet.Cells(RowNum, Count + 1).Value = elem.Length
End If
Next elem
NumberOfAttributes = RowNum - 1
If NumberOfAttributes > 0 Then
excelSheet.Range(Cells(1, 1), Cells(1, 100)).Font.Bold = True
'For a specific set of attribute information this could
'be set to fit the exact number of columns.
excelSheet.Columns("A:G").AutoFit
'Rename the worksheet
Sheets("Sheet1").Name = "Attributes"
If Chart.Value = True Then
CreateChart (NumberOfAttributes)
End If
If Memo.Value = True Then
MakeMemos
End If
Else
MsgBox "No attributes found in the current drawing.", vbInformation
Excel.Quit
End If
Unload Me
End Sub
има още за дялане - сега хваща всички, а не само селектираните например, но бачка
TANSTAAFL! There AiNt Such Thing As A Free LunchРедактирано от onzi на 08.08.06 12:00.