better than flatten?

Hello,

I am looking for a routine that does the same thing that the express
tools flatten does. The support services here do not flatten drawings for
production because they say that the flatten program creates more problems
by making its own layer names and block names, etc.

I use a battery of lisp routines that fail when they encounter 3d

Does anyone know of a program (lisp or vba) that can remove all 3d info
from a draiwng?

thanks for any response

jm

 

You could plot it out to a DXB file, and then DXBIN. However, that will
probably cause more issues than flatten does.

You would have to configure a DXB printer first.

 

Do you need only 3dPolylines... I wrote one for this, well at least it would
take care of them!

Sub PolyConv2D()
Dim sset As AcadSelectionSet, ent As AcadEntity
Dim cadObject As AcadEntity, pt1(0 To 2) As Double, pt2(0 To 2) As
Double
Dim obj3DPline As Acad3DPolyline, pts() As Double, nmbPts As Integer
Dim PTWorld As Variant, OCSNorm, DeltaX As Double, deltaY As Double,
DeltaZ As Double
Dim objPline As AcadPolyline, t As Double, intX As Double, intY As
Double
Dim objPt As AcadPoint, pt(0 To 2) As Double, i As Integer, elev As
Double
Dim LayName As String, lWeight As Integer
Dim test, j As Integer
Set sset = Nothing
Set sset = ThisDrawing.PickfirstSelectionSet
sset.Clear
sset.Select acSelectionSetAll
'convertis toute les polylines 3D en 2D à l'élévation 0 (Zéro)
'elev = InputBox("Elevation : ", , 4500)
For Each ent In sset
If TypeName(ent) = "IAcad3DPolyline" Then
j = j + 1
Set obj3DPline = ent
nmbPts = UBound(obj3DPline.Coordinates)
ReDim pts(nmbPts)
'get points pt1 and pt2 of each segments
For i = 0 To nmbPts Step 3
pts(i) = obj3DPline.Coordinates(i)
pts(i + 1) = obj3DPline.Coordinates(i + 1)
pts(i + 2) = 0
Next
'pour mettre les nouvelles poly sur le bon layer
LayName = ent.layer
lWeight = ent.Lineweight
ent.Delete
Set objPline = ThisDrawing.ModelSpace.AddPolyline(pts)
'applique le layer couleur et lineweight
With objPline
.layer = LayName
.Color = acByLayer
.Lineweight = lWeight
End With
End If
Next
MsgBox (j & " , 3d poly changées")
End Sub