Solved

I need to insert WMF files into Word Document

Posted on 2006-07-24
21
1,524 Views
Last Modified: 2012-06-27
I have exported WMF files from AutoCAD 2000i and have imported into Word document.  The line weights are very thin and almost unreadable.  I need a quick method to increase lineweight on these WMF files.  We had always used HPGL files into AMI pro in the past and that worked well.  We are now using Word exclusively and the WMF files do not import dark enough.
0
Comment
Question by:denverbronx
  • 11
  • 9
21 Comments
 
LVL 16

Expert Comment

by:dhsindy
ID: 17174621
Try going back to your original drawing and change the line work to polylines /lwpolylines and give them the desired lineweight width using the PEDIT command and also you can fill in areas with solid hatch.  Then, after you are satisfied with the image in AutoCAD export it to the WMF format file.

I don't know if you can change it once it is in the Word Document like a linked XLS file for example.  I don't have the 2000i program available anymore to test but this is what I used to do if I remember correctly.

Hope this helps or gives you some ideas.
0
 
LVL 14

Expert Comment

by:Tommy Kinard
ID: 17177073
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

0
 
LVL 14

Expert Comment

by:Tommy Kinard
ID: 17177092
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

0
 

Author Comment

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

0
 

Author Comment

by:denverbronx
ID: 17178789
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.
0
 
LVL 14

Expert Comment

by:Tommy Kinard
ID: 17179078
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

0
 

Author Comment

by:denverbronx
ID: 17179720
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.
0
 
LVL 14

Expert Comment

by:Tommy Kinard
ID: 17179755
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

0
 

Author Comment

by:denverbronx
ID: 17180062
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.
0
 
LVL 14

Expert Comment

by:Tommy Kinard
ID: 17183904
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


0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 

Author Comment

by:denverbronx
ID: 17184713
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.
0
 

Author Comment

by:denverbronx
ID: 17184723
I mean you have posted two subroutines here, Am I to load them both??
0
 
LVL 14

Expert Comment

by:Tommy Kinard
ID: 17184979
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
0
 

Author Comment

by:denverbronx
ID: 17187619
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$$.
0
 
LVL 14

Expert Comment

by:Tommy Kinard
ID: 17187987
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

0
 
LVL 14

Expert Comment

by:Tommy Kinard
ID: 17226915
denverbronx,

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

Otherwise how is it going?

dragontooth

0
 

Author Comment

by:denverbronx
ID: 17227283
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??

0
 
LVL 14

Expert Comment

by:Tommy Kinard
ID: 17227901
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

0
 
LVL 14

Expert Comment

by:Tommy Kinard
ID: 17229499
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

0
 
LVL 14

Accepted Solution

by:
Tommy Kinard earned 500 total points
ID: 17309796
This will take care of arcs.

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.01  '<- 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
        ElseIf TypeOf entry Is AcadArc Then
            Dim Arc As AcadArc
            Set Arc = entry
            MyPts(0) = Arc.StartPoint(0)
            MyPts(1) = Arc.StartPoint(1)
            MyPts(2) = Arc.StartPoint(2)
            MyPts(3) = Arc.EndPoint(0)
            MyPts(4) = Arc.EndPoint(1)
            MyPts(5) = Arc.EndPoint(2)
            MyPts(6) = Arc.EndPoint(0)
            MyPts(7) = Arc.EndPoint(1)
            MyPts(8) = Arc.EndPoint(2)
            Set MyPoly = ThisDrawing.ModelSpace.AddPolyline(MyPts)
            MyPoly.SetBulge 0, Tan(Arc.TotalAngle / 4)
            MyPoly.ConstantWidth = MyThick
            MyPoly.Layer = Arc.Layer
            MyPoly.Linetype = Arc.Linetype
            MyPoly.Update
            Arc.Delete
        End If
    Next entry
    Set entry = Nothing
    Set Arc = Nothing
    Set ACrl = Nothing
    Set MyTrace = Nothing
    Set MyPoly = Nothing
    Set MyLine = Nothing
    ThisDrawing.Regen acActiveViewport
End Sub

dragontooth

0
 

Author Comment

by:denverbronx
ID: 17309899
It works, d'tooth, you have been very, very helpful.  Thanks so much for your fine efforts.
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Suggested Solutions

Following a number of instances of re-installing Solidworks I thought that it may be a  good idea to detail the procedure that I follow each time to ensure a good stable install. Backup: Backup your system.  It goes without saying that this i…
If, like me, you find yourself repeatedly and tediously joining many segments (lines, arcs) in other people's drawings back into polylines that can be used more effectively in Computer Aided Machining and Laser Cutting, then this article is for you!…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now