CADsite forum

Probleemstelling: We tekenen een rechthoek in AutoCAD. Bijvoorbeeld lengte 100, breedte 50. We plaatsen de bematingen. Is het nu mogelijk om met één of andere actie deze twee maten in apparte cellen in excel te krijgen.

Groetjes Steve

mischien dat je iets met OLE object zou kunnen proberen.
daarmee kun je exoprteren naar excel. Ik weet alleen niet of het kan wat jij wilt.

een of andere actie?

mag dat ook selecteren zijn?  daarmee bedoel ik dat je de maatlijnen selecteerd?

Ik heb er zonder antwoord toch maar een kwartiertje aan besteed.....
hij is niet af hoor... maar misschien help dit je op weg.

werkt alleen met dim aligned
en hij opend excel sowieso, of je nu wel of niets selecteerd....
maargoed ik ben dan ook niet bij jullie in dienst...  :-)


Sub test()
Dim Item As AcadEntity
Dim Maat As AcadDimAligned
Dim X As Excel.Application
Dim Rekenblad As Workbook
Dim TabBlad As worksheet
Dim ssKies As AcadSelectionSet

On Error Resume Next 'hier maak je natuurlijk een nette errorhandler voor :-)

Set X = GetObject(, "Excel.Application")
    If err Then
        err.Clear
        Set X = CreateObject("Excel.Application")
    End If
X.Visible = True
   
Set Rekenblad = X.Workbooks.add '("c:\test.xls") 'parameter voor als je een bestaande excelfile wil openen
X.ScreenUpdating = True
Set TabBlad = Rekenblad.Worksheets.Item(1)


' Create the selection set
Set ssKies = ThisDrawing.SelectionSets.Item("gekozen")

    If err Then
        Set ssKies = ThisDrawing.SelectionSets.add("gekozen")
        err.Clear
    Else
        ssKies.Clear
    End If
   
    ' Add objects to a selection set by prompting user to select on the screen
    ssKies.SelectOnScreen
    cnt = 1
   
    For Each Item In ssKies
   
        If Item.ObjectName = "AcDbAlignedDimension" Then
            Set Maat = Item
            TabBlad.Cells(1, cnt) = Maat.Measurement

            cnt = cnt + 1
        End If
   
    Next

End Sub


hey,

sorry, dit programma werkt niet bij mij.  hij geeft iedere keer problemen bij de "sub test ()" en de "Dim X As Excel.Application".

groetjes

benny

heb je in de VBA omgeving wel   bij >>tools  en dan bij  >>references  een vinkje voor Microsoft Excel 9.0 object library gezet?