保存图形和子曲面

BIGAL · 发表于 2022-7-6 17:19:07

我们的情况是，在我们的网络上运行大型作业变得非常缓慢。（请所有IT人员，我们无法更改网络1500个用户）

为了解决这个问题，我们将作业复制到本地驱动器。该作业创建了一个信息数据库以及DWG。

我们想要的是另存为选项
1将图纸复制回服务器（可以使用新菜单命令）

2也将子目录复制到网络（新菜单命令的一部分）

第一个可以通过Autocad完成，但第二个我们必须使用explorer等，并依靠操作员记住要做的事情。

我曾通过对操作系统的外壳处理来使用外部命令，并在Acad中有所暗示。pgp文件，但无法使用复制命令和脚本使其完全工作。

如果有任何建议，VBA可能是更好的选择。

BIGAL · 发表于 2022-7-6 17:32:10

根据我之前的请求，我尝试编辑菜单文件，将^c^c\u saveas更改为^c^c\u saveas explorer

ie运行save autocad，然后弹出浏览器窗口，saveas工作，但没有浏览器任何想法，可能只是缺少斜杠或分号等

BIGAL · 发表于 2022-7-6 17:36:00

另一种想法是，有人可以提供代码，将文件d:\myjobs\test从Autocad中复制到P:\jobno\design。Lisp或vba ok

文件名将更改，但可以从打开的Autocad图形中读取。

pefi · 发表于 2022-7-6 17:43:49

http://www.exceltip.com/st/Basic_file_and_folder_examples_using_VBA_in_Microsoft_Excel/443.html
文件副本“d:\myjobs\test”，“P:\jobno\design”

普尔泽莫

BIGAL · 发表于 2022-7-6 17:49:31

谢谢，这正是我想要的。

额外的选项可以很好地检查现有的etc

它还显示了我先做一件简单的事情，检查VBA帮助输入“文件复制”来定位该命令。

BIGAL · 发表于 2022-7-6 17:53:05

感谢您提供的信息，但现在我有另一个问题，我需要使用通配符即使用*.*一次性复制多文件选项不起作用。

Filecopy似乎一次只能处理一个文件。我现在发现，该软件会根据作业类型创建额外的文件，所以你真的不知道要复制多少文件。
这是一段代码，它可以工作，但不适用于**

civ3dfile=“***”
SourceFile=newdatadrive+“\ Civil 3D Projects\”+JOBNO+“\”+JOBNO+“-data\Advroads\”+civ3dfile

DestinationFile=“P:\”+JOBNO+“\ design\”+JOBNO+“-data\Advroads\”+civ3dfile

文件复制源文件，目标文件

任何帮助都将不胜感激

BIGAL · 发表于 2022-7-6 18:01:34

任何一个看到这个的人都会找到答案，你需要一个循环来查看目录，并使用Dir（文件名）拉出每个文件名，然后复制它。

Megumby · 发表于 2022-7-6 18:07:38

你能发布你的代码示例吗？我一直在尝试同样的事情。
谢谢

BIGAL · 发表于 2022-7-6 18:18:07

希望这有帮助

您只需要一个表单来输入“jobno”和目录字母（newdatadrive）

copy


Private Sub commandbutton1_Click()
Dim newdatadrive As String
Dim jobno As String
Dim MyPath, MyName, checkfile
Dim SourceFile, DestinationFile As String
Dim civ3dfile As String
jobno = projectno.Value
newdatadrive = datadrive.Value + ":"
coggfilecopy1.Hide
'check to see if current drawing
currentdwgname = ThisDrawing.GetVariable("Dwgname") 'noofchar = Len(currentdwgname)
currentdwgname = Mid$(currentdwgname, 1, 7) 'only need 1st 7 characters
'MsgBox "dwg name" & currentdwgname
If currentdwgname = jobno Then
MsgBox "You can not save the drawing if you have it open" & (Chr(13)) & "Please close and try again"
GoTo COGGEND
End If
checkfile = "P:" + jobno + "\Design" + jobno + "-data"
'How to determine if a file exists in a folder:
If Dir(checkfile, vbDirectory) = "" Then
'makenewdir
MsgBox "Directory does not exist now making"
MkDir "P:" + jobno + "\Design" + jobno + "-data"
MkDir "P:" + jobno + "\Design" + jobno + "-data\Advroads"
Else
MsgBox "Directory found now continue" & checkfile
End If
' Define source file name D:\Civil 3D Projects\jobno\jobno.dwg.
SourceFile = newdatadrive + "\Civil 3D Projects" + jobno + "" + jobno + ".dwg"
' Define target file name.
DestinationFile = "P:" + jobno + "\design" + jobno + ".dwg"
'copy file
MsgBox "file copied " & DestinationFile
FileCopy SourceFile, DestinationFile
' Display the names in C:\ that represent directories.
MyPath = newdatadrive + "\Civil 3D Projects" + jobno + "" + jobno + "-data\Advroads"    ' Set the path.
'myname = Dir(Mypath, vbDirectory) '1st entry
MyName = Dir(MyPath)               '2nd entry 1st is .. not needed
Do While MyName <> ""    ' Start the loop.
SourceFile = newdatadrive + "\Civil 3D Projects" + jobno + "" + jobno + "-data\Advroads" + MyName   ' Define source file name D:\Civil 3D Projects\2006100\2006100.dwg.
DestinationFile = "P:" + jobno + "\design" + jobno + "-data\Advroads" + MyName    ' Define source file name D:\Civil 3D Projects\2006100\2006100.dwg.
FileCopy SourceFile, DestinationFile
MsgBox "file copied " & MyName
MyName = Dir    ' Get next entry.
Loop  'end of loop
GoTo COGGEND
notright:
MsgBox "enter a job no or data drive"
frmcoggfilecopy1.Show
COGGEND:
End Sub

Megumby · 发表于 2022-7-6 18:20:30

谢谢你的帮助。

[编程交流] 保存图形和子曲面

发表回复

精选推荐