I need to insert WMF files into Word Document

The problem is the document has a 0.0 line thickness. The below sub will put a thickness in the lines, polylines, and (omg) trace (yes it was some old drawings). The default is 0.003 this will make the lines darker.

Private Sub AcadDocument_Activate()
    Dim entry As AcadObject
    Dim MyLine As AcadLine
    Dim MyTrace As AcadTrace
    Dim MyPoly As AcadPolyline
    Dim MyThick As Double
    Dim MyLineType As ACAD_LTYPE
    Dim MyPoints(0 To 5) As Double
    Dim CordPoints
    MyThick = 0.003
    For Each entry In ThisDrawing.ModelSpace
         'MsgBox entry.ObjectName
         If TypeOf entry Is AcadLine Then
            Set MyLine = entry
            MyLineType = MyLine.Linetype
            MyPoints(0) = MyLine.EndPoint(0)
            MyPoints(1) = MyLine.EndPoint(1)
            MyPoints(2) = 0
            MyPoints(3) = MyLine.StartPoint(0)
            MyPoints(4) = MyLine.StartPoint(1)
            MyPoints(5) = 0
            Set MyPoly = ThisDrawing.ModelSpace.AddPolyline(MyPoints)
            MyPoly.ConstantWidth = MyThick
            MyPoly.Linetype = MyLineType
            MyPoly.Update
            MyLine.Delete
            'Set MyLine = Nothing
            'Set MyPoly = Nothing
         ElseIf TypeOf entry Is AcadTrace Then
            Set MyTrace = entry
            CordPoints = MyTrace.Coordinate(0)
            MyPoints(0) = CordPoints(0)
            MyPoints(1) = CordPoints(1)
            MyPoints(2) = CordPoints(2)
            CordPoints = MyTrace.Coordinate(3)
            MyPoints(3) = CordPoints(0)
            MyPoints(4) = CordPoints(1)
            MyPoints(5) = CordPoints(2)
            Set MyPoly = ThisDrawing.ModelSpace.AddPolyline(MyPoints)
            MyPoly.ConstantWidth = MyThick
            MyPoly.Update
            MyTrace.Delete
            'Set MyTrace = Nothing
            'Set MyPoly = Nothing
        End If
    Next entry
    Set entry = Nothing
    Set MyTrace = Nothing
    Set MyPoly = Nothing
    Set MyLine = Nothing
End Sub

HTH
dragontooth

Sorry I forgot, dhsindy is correct in the assesment of drawings will have to be corrected. There is an editor for wmf's, but fixing the drawing is much faster.

dragontooth

Where would I nout this sub.  I have not used AutoCad extensively recently and I am not familiar with what you are saying.

I used the PEdit to change the line width and this works with the WMF.  However this is very cumbersome and drawnout.  I am seeking a solution that may work globally.  The layer Lineweight option does not work at all.  I appreciate your efforts.

press Alt+F11 and the vba ide will appear, in the upper left hand corner double click the ThisDrawing icon and paste the code below in to the code pane on the right.

Private Sub AcadDocument_Activate()
    Dim entry As AcadObject
    Dim MyThick As Double
    MyThick = 0.2
    For Each entry In ThisDrawing.ModelSpace
        If TypeOf entry Is AcadLine Then
            'entry.Lineweight = acLnWt009
            If entry.Thickness = 0# Then entry.Thickness = MyThick
        ElseIf TypeOf entry Is AcadLWPolyline Then
            'entry.Lineweight = acLnWt009
            If entry.Thickness = 0.2 Then entry.Thickness = MyThick
        End If
    Next entry
    Set entry = Nothing
End Sub

This will give each line and lwpolyline in the drawing that is opened the thickness of 0.2.

You will need to save the project so you can reload it. On the toolbar pick file -> save.

After this is done open a drawing and the lines and polylines will be updated automatically. Save the wmf close drawing and open the next one........

HTH
dragontooth

I did everything according to your instructions but it doesn't appear to be changing my linewidths.

Is there soemthing else I need to do to load this sub everytime or with each drawing.  Thanks so much for your help.

It will not change the thicknesses visibly. Do a list on a line and the thickness should be 0.2.

How do the wmf's look?

dragontooth

I listed out the line and the width is not recorded.  The linewidth remains as .0000

I will try this out more tomorrow.  Thanks for your jhelp.

The WMF's still print out the same.

I will repost this sub it will redraw all lines, and traces to polylines, the polylines will be reset to a width of .2 units. Depending on the size of drawing inserted and the size of paper being used, you may need to play with the polyline width until you get it fixed the way you want.

Start a new copy of acad, paste this code into a code window, save the project. Do not close acad and open an existing drawing, the lines will be deleted and polylines will replace them, if you do a list on a line and it is not a poly something is wrong.

Private Sub AcadDocument_Activate()
    Dim entry As AcadObject
    Dim MyLine As AcadLine
    Dim MyTrace As AcadTrace
    Dim MyPoly As AcadPolyline
    Dim MyThick As Double
    Dim MyLineType As ACAD_LTYPE
    Dim MyPoints(0 To 5) As Double
    Dim CordPoints
    MyThick = 0.2  '<- polyline width adjust as required
    For Each entry In ThisDrawing.ModelSpace
         If TypeOf entry Is AcadLine Then
            Set MyLine = entry
            MyLineType = MyLine.Linetype
            MyPoints(0) = MyLine.EndPoint(0)
            MyPoints(1) = MyLine.EndPoint(1)
            MyPoints(2) = 0
            MyPoints(3) = MyLine.StartPoint(0)
            MyPoints(4) = MyLine.StartPoint(1)
            MyPoints(5) = 0
            Set MyPoly = ThisDrawing.ModelSpace.AddPolyline(MyPoints)
            MyPoly.ConstantWidth = MyThick
            MyPoly.Linetype = MyLineType
            MyPoly.Layer = MyLine.Layer
            MyPoly.Update
            MyLine.Delete
         ElseIf TypeOf entry Is AcadTrace Then
            Set MyTrace = entry
            CordPoints = MyTrace.Coordinate(0)
            MyPoints(0) = CordPoints(0)
            MyPoints(1) = CordPoints(1)
            MyPoints(2) = CordPoints(2)
            CordPoints = MyTrace.Coordinate(3)
            MyPoints(3) = CordPoints(0)
            MyPoints(4) = CordPoints(1)
            MyPoints(5) = CordPoints(2)
            Set MyPoly = ThisDrawing.ModelSpace.AddPolyline(MyPoints)
            MyPoly.ConstantWidth = MyThick
            MyPoly.Layer = MyTrace.Layer
            MyPoly.Update
            MyTrace.Delete
        ElseIf TypeOf entry Is AcadPolyline Then
            entry.ConstantWidth = MyThick
            entry.Update
        End If
    Next entry
    Set entry = Nothing
    Set MyTrace = Nothing
    Set MyPoly = Nothing
    Set MyLine = Nothing
End Sub

Good luck
dragontooth

Well dragontooth, I am feeling quite long in the tooth.  I pasted this sub into the VBE window as you asked and I saved the project.  It does not appear to be working on anything.  Is there something I am doing wrong.  How do you get this sub to initiate and run.  I see that it is loaded but there isn't any changes taking place to my drawing.  I am feeling really stupid right now.

I mean you have posted two subroutines here, Am I to load them both??

Either sub will initiate and run when you open an existing drawing. Or it is supposed to :)
The last sub works for sure because I did it. The line weight/thickness was not correct but I inserted a 22x34 drawing on a 8.5x11 page, so I increased the thickness to 0.5.

I inserted the wmf into the Word doc, with insert pic from file.

I have just plain old acad with no 3rd party apps. If you want to you can view my profile and send a drawing, I'll see if I am having a brain cramp or if something else is interfering, also send a word doc (I have Office 2000)

Otherwise I'll set it up for you.

LOL long in the tooth, you can't be that old

dragontooth

Well dragontooth,

I am 56 to be exact.  A strange thing happen while I was working in a drawing today. all of the sudden line weights (thickness) were changing.  So I believe this sub is working but I don't think it works on all lines.  Perhaps I didn't give it enough time.  I have been working with AutoCad since 1985 and I have lost some of my expertise by not using it everyday.  I now am more of a salesman than an engineer.  But I get to do all of it at times.  I am going to try this some more this afternoon.  I think it is working but I still am not seeing all the lines update.  The text is still thin and I don't know how to resolve that.  It used to be so easy with AmiPro and HPGL files and now it is a pain in the a$$.

LOL I am 48, worked with acad since '87 inhouse developed graphics apps since '77. I used to detail steel, now I write the apps to detail steel. I prefer importing plt files into wordperfect, I got what I wanted. Worked real good for "help" files.

I am not looking at splines at all, am adjusting plines' width not the thickness. Change the text to ttf and bold, that 'may' work. I can't remember if acad 2000i does ttf right, but I know 14 didn't.

Let me kow I'll still be around :)
dragontooth

denverbronx,

I think the lines that are not changing are in blocks? Maybe?

Otherwise how is it going?

dragontooth

Actually, they are not blocks.  The ones that won't change are just plain polylines.  I cannot explain why they are not changing.  I am going on vacation 8/3 thru 8/9 and I won't be able to check this out b4 I return.  It is extremely busy for me at work these days.  I bounce from one problem (spelled opportunity) to the next.  This problem has been hanging around for several years but I need to get resolved.  Thanx, d'tooth for your patience.  Perhaps I could send you the file in question??

OK see my profile for e-mail will returned fixed with the fix installed.

I think the polys are 3dpoly I am not looking at that one.

<<I bounce from one problem (spelled opportunity) to the next.>>
LOL that is why I have the "job" I have, I fix all the "opportunities" from here, I used to call myself the fireman for all the hotspots I get thrown into, interesting though, never a dull moment. :)

dragontooth

My Bad, I wasn't looking for circles at all must less lwpolylines these will fix it.

Private Sub AcadDocument_Activate()
    Dim entry As AcadObject
    Dim MyLine As AcadLine
    Dim MyTrace As AcadTrace
    Dim MyPoly As AcadPolyline
    Dim MyThick As Double
    Dim MyLineType As ACAD_LTYPE
    Dim MyPoints(0 To 5) As Double
    Dim ACrl As AcadCircle
    Dim MyPts(0 To 8) As Double
    Dim CordPoints
    MyThick = 0.1  '<- polyline width adjust as required
    For Each entry In ThisDrawing.ModelSpace
         If TypeOf entry Is AcadLine Then
            Set MyLine = entry
            MyLineType = MyLine.Linetype
            MyPoints(0) = MyLine.EndPoint(0)
            MyPoints(1) = MyLine.EndPoint(1)
            MyPoints(2) = 0
            MyPoints(3) = MyLine.StartPoint(0)
            MyPoints(4) = MyLine.StartPoint(1)
            MyPoints(5) = 0
            Set MyPoly = ThisDrawing.ModelSpace.AddPolyline(MyPoints)
            MyPoly.ConstantWidth = MyThick
            MyPoly.Linetype = MyLineType
            MyPoly.Layer = MyLine.Layer
            MyPoly.Update
            MyLine.Delete
         ElseIf TypeOf entry Is AcadTrace Then
            Set MyTrace = entry
            CordPoints = MyTrace.Coordinate(0)
            MyPoints(0) = CordPoints(0)
            MyPoints(1) = CordPoints(1)
            MyPoints(2) = CordPoints(2)
            CordPoints = MyTrace.Coordinate(3)
            MyPoints(3) = CordPoints(0)
            MyPoints(4) = CordPoints(1)
            MyPoints(5) = CordPoints(2)
            Set MyPoly = ThisDrawing.ModelSpace.AddPolyline(MyPoints)
            MyPoly.ConstantWidth = MyThick
            MyPoly.Layer = MyTrace.Layer
            MyPoly.Update
            MyTrace.Delete
        ElseIf TypeOf entry Is AcadPolyline Then
            entry.ConstantWidth = MyThick
            entry.Update
        ElseIf TypeOf entry Is AcadLWPolyline Then
            entry.ConstantWidth = MyThick
            entry.Update
        ElseIf TypeOf entry Is AcadCircle Then
            Set ACrl = entry
            MyPts(0) = ACrl.Center(0) + ACrl.radius
            MyPts(1) = ACrl.Center(1)
            MyPts(3) = ACrl.Center(0) - ACrl.radius
            MyPts(4) = ACrl.Center(1)
            MyPts(6) = ACrl.Center(0) + ACrl.radius
            MyPts(7) = ACrl.Center(1)
            Set MyPoly = ThisDrawing.ModelSpace.AddPolyline(MyPts)
            MyPoly.SetBulge 0, -1#
            MyPoly.SetBulge 1, -1#
            MyPoly.SetBulge 2, -1#
            MyPoly.ConstantWidth = MyThick
            MyPoly.Layer = ACrl.Layer
            MyPoly.Linetype = ACrl.Linetype
            MyPoly.Update
            ACrl.Delete
        End If
    Next entry
    Set entry = Nothing
    Set ACrl = Nothing
    Set MyTrace = Nothing
    Set MyPoly = Nothing
    Set MyLine = Nothing
    ThisDrawing.Regen acActiveViewport
End Sub

dragontooth