QQ登录

只需一步,快速开始

登录 | 注册 | 找回密码

三维网

 找回密码
 注册

QQ登录

只需一步,快速开始

展开

通知     

查看: 1534|回复: 5
收起左侧

[求助] 批量转cad和pdf宏错误,请高手指导

[复制链接]
发表于 2016-1-11 22:21:16 | 显示全部楼层 |阅读模式 来自: 中国浙江温州

马上注册,结识高手,享用更多资源,轻松玩转三维网社区。

您需要 登录 才可以下载或查看,没有帐号?注册

x
批量转cad和pdf宏错误,请高手指导,字体加粗的位置就不对了7 r8 m8 V/ P, |. d  V& B2 Z8 m
代码如下
8 z( t' ?( F# Z+ C& l, WDim swApp As Object
! L( G7 D! U0 g9 H4 eDim Part As Object
, w  k# k+ w% c: XDim boolstatus As Boolean5 v  B- v% B+ g: ]
Dim longstatus As Long, longwarnings As Long
  }9 a- x& \0 R7 q6 q$ _4 F8 V3 o7 XDim PathStr As String
- Y( y, r* p) |* n: @' ?4 a0 ?$ TDim FName(500) As String, FNum As Long
; o( c( N1 H$ {% _" [Sub main()- N0 T8 p6 g( Z+ U& U
Dim i As Long
) Y! y1 T# V% Z. lDim PathStr0 As String, PathStr1 As String9 n) m8 j6 |3 _. C$ x
Dim PathStr2 As String, PathStr3 As String, PathStr4 As String, PahtStr5 As String# ~5 d7 s/ k( k% e
Dim L As Long, L1 As Long% Y3 _6 N* Y; `. y' u9 _9 Z# ?
PathStr = InputBox("请输入需要转的工程图所在位置")* N6 c- y) V2 t( ^% `2 \
Call Showfilelist(PathStr)
( h: o7 Y% I8 h& R5 y" w/ C- o7 hSet swApp = Application.SldWorks
, L2 _1 ~" \! t5 h3 O0 [' f3 {' Z) lFor i = 0 To FNum - 1/ i4 W8 h# Z( R
    PathStr0 = PathStr & "\" & FName(i)
& F6 y  W/ s1 M& M1 ?4 o* M: _% Q    Set Part = swApp.OpenDoc6(PathStr0, 3, 0, "", longstatus, longwarnings)
. d: k+ ?/ I7 n    L = Len(PathStr0); s/ a9 y# u( F$ Y1 i4 s7 K
    PathStr1 = Left(PathStr0, L - 7) & ".DWG"; ?4 k$ Z  z; g: n2 ~7 c) N1 Y
    PathStr2 = Left(PathStr0, L - 7) & ".PDF", Y% a8 J2 v. E& v% b  t; \
    longstatus = Part.SaveAs3(PathStr1, 0, 0)- Z' r7 |3 s8 j9 c5 ?' u
    longstatus = Part.SaveAs3(PathStr2, 0, 0); v8 T( k7 H& j. o% v) _5 `& l
   
7 R- a9 z5 S. c" b8 v    Set Part = Nothing
' H& g0 r! n8 _$ ~    " ~0 Z  U# n- E* @4 |5 _; x
    L1 = Len(FName(i))
8 {# P- ~8 O; `( z% Q: J- L- i7 m    PathStr3 = Left(FName(i), L1 - 7) & " - 图纸1"% n6 a; x, k2 _( d: g6 b
    PathStr4 = Left(FName(i), L1 - 7) & " - 图纸2"4 t2 d4 s% L, ~! C& B7 A
    PathStr5 = Left(FName(i), L1 - 7) & " - 图纸3"
7 X  q$ J! v$ g) [+ S   
: s# F- \( c* z+ U( _1 b* S' ?4 t2 K    swApp.CloseDoc PathStr3' w* J' h! F" {- S% v
    swApp.CloseDoc PathStr4
" p9 `6 x. N+ b# b8 p    swApp.CloseDoc PathStr5
+ @" j2 M; d- f9 UNext i+ e; K3 @* K+ W- h/ i# ?
End Sub
$ K* ^( \7 x, |. E% CPrivate Sub Showfilelist(folderspec As String)' o( X. n7 x5 K# R
     Dim fs, f, f1, fc, s
+ |/ m5 d2 L3 X7 T- ?1 x     Set fs = CreateObject("Scripting.FileSystemObject")  y1 @- H% N- Q2 p7 u1 @
     Set f = fs.GetFolder(folderspec)
) x# Y3 B# i6 E2 Q( e     Set fc = f.Files
- ^5 w% A! q) q" ^4 E, L     FNum = 0 '清零( e* d9 d  A0 t$ v" ?% X; K+ [
     For Each f1 In fc
. Q  M2 S) p! s  n4 U, ~5 Q        If InStr(f1.Name, "SLDDRW") > 0 Then- Z8 I4 t8 P& x$ T0 `
            FName(FNum) = f1.Name* r9 j3 a8 q- K( d# K6 u
            FNum = FNum + 1
0 P1 a5 n5 t# Q+ M/ j        End If' u! E4 v# J+ Y* g/ r0 i' H
     Next; T: ~) U, g, j1 P) Z
End Sub
& S$ M/ D4 c2 T( V$ c

工程图转换.rar

6.66 KB, 下载次数: 18

宏文件

发表于 2016-1-12 08:12:37 | 显示全部楼层 来自: 中国上海
试试,谢谢楼主
发表于 2016-1-12 10:47:16 | 显示全部楼层 来自: 中国广东佛山
理论上用saveas3 是没问题的。
4 X, G. u8 O" b: J2 K8 Q& N楼主调试一下试试,看看
发表于 2016-1-12 13:16:20 | 显示全部楼层 来自: 中国广东佛山
本帖最后由 linuxbyte 于 2016-1-12 16:32 编辑 ; k* O" J7 ~' |; [3 e$ y
0 p: P- m2 g0 Y. s* a. x% t
WIN7 x64 + SW2011 上述附件无错通过。% X4 S* |- T* @4 G6 p) L+ u5 Z0 O
 楼主| 发表于 2016-1-12 20:50:54 | 显示全部楼层 来自: 中国广东佛山
可是2016不行
/ O" p# i3 y4 l2 ^6 R' M9 G, P. z# t5 Y
发表于 2016-1-14 13:13:31 | 显示全部楼层 来自: 中国广东佛山
2016 x64 SP0.1 + WIN7 通过
发表回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则


Licensed Copyright © 2016-2020 http://www.3dportal.cn/ All Rights Reserved 京 ICP备13008828号

小黑屋|手机版|Archiver|三维网 ( 京ICP备2023026364号-1 )

快速回复 返回顶部 返回列表