draftsight skupna dolžina

[korenje]

A kdo ve kako izmerit izbrano dolžino elementov v draftsight?
Trenutno je tako da moram joinat elemente in potem izmerit kar zna biti naporno. Problem je še ker se v draftsight lahko joina samo sorodne elemente (ravne črte, loki, polyline ipd posebej).

V autocad sem imel napisan program za izmerit dolžino vseh elementov, v draftsight pa tega ni... ?

[Deutz]

A kdo ve kako izmerit izbrano dolžino elementov v draftsight?
Trenutno je tako da moram joinat elemente in potem izmerit kar zna biti naporno. Problem je še ker se v draftsight lahko joina samo sorodne elemente (ravne črte, loki, polyline ipd posebej).

Če sem te prav razumel potem je možno izmerit z orodjem "dimension" in ko zmeriš potem undo da zbrišeš... ali pa misliš na kaj drugega !?

dimension_001.jpg (16.38 KiB) Videno 17930 krat

[korenje]

Zanima me kako izmerit dolžino vseh črt, ki niso samo ravne črte.

[Deutz]

Zanima me kako izmerit dolžino vseh črt, ki niso samo ravne črte.

...misliš dolžino objekta ki je sestavljen od različnih črt ki niso samo ravne črte, ali pa dolžino vseh črt ki sestavljajo objekt kot mpr. obseg ?

[korenje]

Zanima me kako izmerit dolžino vseh črt, ki niso samo ravne črte.

...misliš dolžino objekta ki je sestavljen od različnih črt ki niso samo ravne črte, ali pa dolžino vseh črt ki sestavljajo objekt kot mpr. obseg ?

Na splošno vse izbrane črte.

[Deutz]

...z "get properties" dobiš dolžine posameznih črt. Za krožnico pa ne...

get_properties_001.jpg (26.68 KiB) Videno 17806 krat

[borisk]

a draftsign ne podpira LISP in VB? mislim da ga, ker pri nas uporabljamo gstar CAD za dxf/dwg odpiranje in lahk zaganjaš autocad skripte.

[ManiaC]

Kolk vem rabiš pro verzijo da lahko uporabljaš makroje.

[korenje]

Imamo pro verzijo, samo se mi zdi da autocad lisp (len macro) ne dela. Pa ne vem zakaj. Verjetno draftsight nima integriranih vseh funkcij kot so pri autocadu.

[ManiaC]

Verjetno ima kakšne drugačne ukaze...

Nikoli nisem imel ds pro, tako da ne znam pomagat.

Verjetno pa ima kakšno "record" opcijo s katero si lahko potem pomagaš. Potem pa preko loop zankah sešteješ vse skupaj.

[borisk]

če maš licenco jih poklič pa zateži, zato so tam ali pa ti bodo povedali kako stvar rešit...

[korenje]

ok k sreči draftsight pro podpira vba.
Tako da sem naredil nekaj takega. Prebere še blok z atributi, kjer so zapisani potrebni podatki za laserski razrez.

Koda: Izberi vse

Private Function ReadBlockFile(ByRef dsApp As DraftSight.Application, ByRef dsDoc As DraftSight.Document, ByRef dsModel As DraftSight.Model, ByRef dsSketchManager As DraftSight.SketchManager, ByRef dsViewManager As DraftSight.ViewManager, dsSelectionManager As DraftSight.SelectionManager) As Variant
    Dim s_masa, s_material, s_naziv, s_obdelava, s_opomba, s_strisbe, s_kolicina, s_ident, s_debelina, s_dolzina, s_povrsina
   
    Dim objcount As Integer, selectedObjectsType As Variant, selectedObjects As Variant, contour() As Object, contourtypes() As dsObjectType_e, contourdim() As Object, contourdimtypes() As dsObjectType_e, blocks() As Object, blockstypes() As dsObjectType_e, boundx1 As Double, boundy1 As Double, boundx2 As Double, boundy2 As Double, X1 As Double, Y1 As Double, z1 As Double, X2 As Double, Y2 As Double, z2 As Double, bounddimx As Double, bounddimy As Double
    ReDim contour(0)
    ReDim contourtypes(0)
    ReDim contourdim(0)
    ReDim contourdimtypes(0)
    ReDim blocks(0)
    ReDim blockstypes(0)
    ' line length
    Call dsSketchManager.GetEntities(dsSelectionManager.GetSelectionFilter, Null, selectedObjectsType, selectedObjects)
    If IsEmpty(selectedObjects) = False Then
        Dim length As Double
        For i = 0 To UBound(selectedObjects)
            Select Case selectedObjectsType(i)
            Case dsCircleArcType, dsCircleType, dsLineType, dsMathCircArcType, dsMathEllipArcType, dsMathLineType, dsPolyLineType, dsSplineType
                length = length + selectedObjects(i).GetLength
                Set contour(UBound(contour)) = selectedObjects(i)
                ReDim Preserve contour(UBound(contour) + 1)
                contourtypes(UBound(contourtypes)) = selectedObjectsType(i)
                ReDim Preserve contourtypes(UBound(contourtypes) + 1)
                Call selectedObjects(i).GetBoundingBox(X1, Y1, z1, X2, Y2, z2)
                If objcount = 0 Then
                    boundx1 = X1
                    boundy1 = Y1
                    boundx2 = X2
                    boundy2 = Y2
                Else
                    If X1 < boundx1 Then boundx1 = X1
                    If Y1 < boundy1 Then boundy1 = Y1
                    If X2 > boundx2 Then boundx2 = X2
                    If Y2 > boundy2 Then boundy2 = Y2
                End If
                objcount = objcount + 1
            Case dsAlignedDimensionType, dsAngularDimensionType, dsAngularDimensionType_2Line, dsAngularDimensionType_3Point, dsArcLengthDimensionType, dsDiameterthDimensionType, dsGeneralDimensionType, dsJoggedDimensionType, dsOrdinateDimensionType, dsRadialDimensionType, dsRotatedDimensionType
                Set contourdim(UBound(contourdim)) = selectedObjects(i)
                ReDim Preserve contourdim(UBound(contourdim) + 1)
                contourdimtypes(UBound(contourdimtypes)) = selectedObjectsType(i)
                ReDim Preserve contourdimtypes(UBound(contourdimtypes) + 1)
            Case dsBlockInstanceType
                Set blocks(UBound(blocks)) = selectedObjects(i)
                ReDim Preserve blocks(UBound(blocks) + 1)
                blockstypes(UBound(blockstypes)) = selectedObjectsType(i)
                ReDim Preserve blockstypes(UBound(blockstypes) + 1)
            End Select
        Next
        If UBound(contour) > -1 Then ReDim Preserve contour(UBound(contour) - 1)
        If UBound(contourtypes) > -1 Then ReDim Preserve contourtypes(UBound(contourtypes) - 1)
        If UBound(contourdim) > -1 Then ReDim Preserve contourdim(UBound(contourdim) - 1)
        If UBound(contourdimtypes) > -1 Then ReDim Preserve contourdimtypes(UBound(contourdimtypes) - 1)
        If UBound(blocks) > -1 Then ReDim Preserve blocks(UBound(blocks) - 1)
        If UBound(blockstypes) > -1 Then ReDim Preserve blockstypes(UBound(blockstypes) - 1)
    End If

    bounddimx = Abs(Abs(boundx1) + boundx2)
    bounddimy = Abs(Abs(boundy1) + boundy2)
'    dsApp.GetCommandMessage.PrintLine "Total length: " & Round(Length, 2) & " mm" & vbNewLine _
'    & "Grouped entities: " & RGroupBlock.GetEntitiesCount & vbNewLine _
'    & "Bounding box: X1:" & boundx1 & " Y1:" & boundy1 & " X2:" & boundx2 & " Y2:" & boundy2 & vbNewLine _
'    & "Bound dimension: " & Round(bounddimx, 2) & "x" & Round(bounddimy, 2)

' used variables:
' contour [object]: contour
' Length [double]: Length
' Bounds [double]: boundx1, boundy1, boundx2, boundy2
' Bound dim. [double]: bounddimx, bounddimy

    ' blocks
    Dim blockinst As BlockInstance, battrdef() As Object, attrdef As DraftSight.AttributeDefinition, battrinst() As Object, attrinst As DraftSight.AttributeInstance
    dsSelectionManager.GetSelectionFilter.AddEntityType dsBlockInstanceType
    Call dsSketchManager.GetEntities(dsSelectionManager.GetSelectionFilter, Null, selectedObjectsType, selectedObjects)
    If IsEmpty(selectedObjects) = False Then
        For i = 0 To UBound(selectedObjects)
            Select Case selectedObjectsType(i)
            Case dsBlockInstanceType
                Set blockinst = selectedObjects(i)
                'dsApp.GetCommandMessage.PrintLine "Block Handle: " & blockinst.GetBlockDefinition.Handle & vbNewLine _
                '& "Block Name: " & blockinst.GetBlockDefinition.GetName
                If blockinst.GetBlockDefinition.GetName = "DWG_TITLEBLOCK" Then
                    battrdef = blockinst.GetBlockDefinition.GetAttributeDefinitions
                    battrinst = blockinst.GetAttributeInstances
                    Exit For
                End If
            End Select
        Next
        'dsApp.GetCommandMessage.PrintLine "Counted blocks: " & ObjCount
    End If
    If Not UBound(battrdef) < 0 Then
        For i = 0 To UBound(battrdef)
            Set attrdef = battrdef(i)
            Set attrinst = battrinst(i)
            Select Case attrdef.Name
            Case "DEBELINA"
                If LenB(s_debelina) > 0 Then
                    attrinst.Value = s_debelina
                Else
                    s_debelina = attrinst.Value
                End If
            Case "DOLZINA_REZA"
                If LenB(s_dolzina) > 0 Then
                    attrinst.Value = s_dolzina
                Else
                    attrinst.Value = Round(length, 2)
                    s_dolzina = attrinst.Value
                End If
            Case "IDENT"
                If LenB(s_ident) > 0 Then
                    attrinst.Value = s_ident
                Else
                    s_ident = attrinst.Value
                End If
            Case "KOLICINA"
                If LenB(s_kolicina) > 0 Then
                    attrinst.Value = s_kolicina
                Else
                    If IsNumeric(attrinst.Value) = False Then
                        attrinst.Value = 0
                    End If
                    s_kolicina = attrinst.Value
                End If
            Case "MATERIAL"
                If LenB(s_material) > 0 Then
                    attrinst.Value = s_material
                Else
                    s_material = attrinst.Value
                End If
            Case "NAZIV"
                If LenB(s_naziv) > 0 Then
                    attrinst.Value = s_naziv
                Else
                    s_naziv = attrinst.Value
                End If
            Case "OBDELAVA"
                If LenB(s_obdelava) > 0 Then
                    attrinst.Value = s_obdelava
                Else
                    s_obdelava = attrinst.Value
                End If
            Case "OPOMBA"
                If LenB(s_opomba) > 0 Then
                    attrinst.Value = s_opomba
                Else
                    s_opomba = attrinst.Value
                End If
            Case "POVRSINA"
                If LenB(s_povrsina) > 0 Then
                    attrinst.Value = s_povrsina
                Else
                    attrinst.Value = Round(bounddimx, 1) & "x" & Round(bounddimy, 1)
                    s_povrsina = attrinst.Value
                End If
            Case "ST_RISBE"
                If LenB(s_strisbe) > 0 Then
                    attrinst.Value = s_strisbe
                Else
                    s_strisbe = attrinst.Value
                End If
            End Select
        Next
        For i = 0 To UBound(battrdef)
            Set attrdef = battrdef(i)
            Set attrinst = battrinst(i)
            Select Case attrdef.Name
            Case "MASA"
                If LenB(s_masa) > 0 Then
                    attrinst.Value = s_masa
                Else
                    attrinst.Value = Round(calc_masa(bounddimx, bounddimy, IIf(IsNumeric(s_debelina) = True, s_debelina, 0), 8), 1)
                    s_masa = attrinst.Value
                End If
            End Select
        Next
    End If
' used variables:
' BlockInstance: blockinst
' Block attributes: s_masa, s_material, s_naziv, s_obdelava, s_opomba, s_strisbe, s_kolicina, s_ident, s_debelina, s_dolzina, s_povrsina
   
    ReadBlockFile = Array(Array(contourtypes, contour, contourdimtypes, contourdim, blockstypes, blocks), Array(length, bounddimx, bounddimy, boundx1, boundy1), Array(s_masa, s_material, s_naziv, s_obdelava, s_opomba, s_strisbe, s_kolicina, s_ident, s_debelina, s_dolzina, s_povrsina))
End Function
Function calc_masa(ByVal X As Double, ByVal Y As Double, ByVal s As Double, ByVal density As Double)
    calc_masa = (X * Y * s) / 1000000 * density
End Function