Public Sub CLOSE_ALL_SAVED() 'FECHA OS DESENHOS SEM SALVAR E SEM PEDIR PARA SALVAR
Dim DOC As AcadDocument
Set DOC = ThisDrawing
For Each DOC In Documents
DOC.Close False
Next
Set DOC = Nothing
End Sub
Public Sub Save_Drawing_Lantek() 'Salva os desenhos no diret鏎io k:\
Dim i As Long ' command sd
Dim Desenho As AcadDocument
Dim Codigo As String
Dim NovoCodigo As String
Dim Resposta As Integer
Set Desenho = ThisDrawing
' If there are no open documents, then exit
Codigo = Desenho.FullName
For i = 1 To Len(Codigo) + 1 ' procurar valor num廨ico e monta o nome com 6 valores num廨icos
If Mid(Codigo, i, 1) <= 9 Then
lblPalavra = Mid(Codigo, i, 1)
If Len(NovoCodigo) <= 5 Then
NovoCodigo = NovoCodigo + Mid(Codigo, i, 1)
End If
End If
Next i
Resposta = MsgBox("Desenho barrado?", vbExclamation + vbYesNoCancel + vbDefaultButton2)
If Resposta = vbNo Then
Desenho.SaveAs ("k:\tempdwg\" & NovoCodigo & ".dwg")
Desenho.SendCommand "ss" & vbCr
ElseIf Resposta = vbYes Then
Dim Message, Title, Default, Barrado
Message = "Qual a barra do desenho" & NovoCodigo & "/" ' Set prompt.
Title = "InputBox para desenhos barrados" ' Set title.
Default = "1" ' Set default.
' Display message, title, and default value.
Barrado = InputBox(Message, Title, Default)
Desenho.SaveAs ("k:\tempdwg\" & NovoCodigo & "-" & Barrado & ".dwg")
Desenho.SendCommand "ss" & vbCr
End If
Set Desenho = Nothing
End Sub
Public Sub Deletar_Dwg() 'Deletar desenhos dwg no diret鏎io k:\
If MsgBox("Deseja apagar todos os desenhos dwg no dir. k:\?", vbCritical + vbYesNo + vbDefaultButton2) = vbNo Then
Exit Sub
Else
On Error Resume Next
Kill "k:\tempdwg\*.dwg"
On Error Resume Next
Kill "k:\tempdwg\*.bak"
End If
End Sub
Public Sub Erase_all_Remove() ' Usar teclas er para acionar o comando
ThisDrawing.SendCommand "e" & vbCr & "all" & vbCr & "r" & vbCr
End Sub
(defun c:sd ()
;(setvar "filedia" 0)
;(command "_VBALOAD" "c:\\Lisp\\Save_Des_Lantek.dvb")
(setvar "filedia" 1)
(command "_-VBARUN" "Save_Drawing_Lantek")
)
|
 讓我們程式搜尋結果更加完美 如果您覺得該文件有幫助到您，煩請按下我如果您覺得該文件是一個一無是處的文件，也煩請按下我 |
|
該文件您看起來是亂碼嗎？您可以切換編碼方式試試看！ISO-8859-1 | latin1 | euc-kr | euc-jp | CP936 | CP950 | UTF-8 | GB2312 | BIG5 |
|