社区 › VB › VBA图像控制

284 发表于 2006-3-15 11:25:59

VBA图像控制

**** Hidden Message *****

问题 发表于 2006-3-15 12:16:00

您是要重命名tif文件还是只重命名绘图中的tif引用名称？

樱吧招人堂 发表于 2006-3-15 12:22:07

一些细节
1）路径是否保存在tifs
a）如果是，总是，肯定？
b）如果不是，它们在绘图文件夹中吗？
2）绘图中是否有多个tif？
3）新的tif名称是否始终是绘图名称？
4）您还能想到什么？

男人帮 发表于 2006-3-15 13:16:10

1-是，2-否3 -是4-我饿了4-我需要小睡一会儿

新歌 发表于 2006-3-15 13:18:04

试试这个
Sub RastaRenameMon()
Dim objSelSets As AcadSelectionSets
Dim objSelSet As AcadSelectionSet
Dim intType(0) As Integer
Dim varData(0) As Variant
Dim objImg As AcadRasterImage
Dim objNewImg As AcadRasterImage
Dim strImgName As String
Dim strDwgName As String
Dim strImgExt As String
Dim strImgPath As String
Dim strNewName As String

strDwgName = Left(ThisDrawing.Name, Len(ThisDrawing.Name) - 4)
Set objSelSets = ThisDrawing.SelectionSets
For Each objSelSet In objSelSets
    If objSelSet.Name = "Imagen" Then
      objSelSets.Item("Imagen").Delete
      Exit For
    End If
Next
Set objSelSet = objSelSets.Add("Imagen")
intType(0) = 0
varData(0) = "IMAGE"
objSelSet.Select acSelectionSetAll, _
filtertype:=intType, filterdata:=varData
If objSelSet.Count > 0 Then
For Each objImg In objSelSet
    strImgExt = Right(objImg.ImageFile, 4)
    strImgName = objImg.Name
    strImgPath = Left(objImg.ImageFile, Len(objImg.ImageFile) - Len(strImgName) - 4)
    strNewName = strImgPath & strDwgName & strImgExt
    FileCopy objImg.ImageFile, strNewName
    Set objNewImg = PaperSpace.AddRaster(strNewName, objImg.Origin, objImg.ScaleFactor, objImg.Rotation)
    DetachImage (strImgName)
    Kill strImgPath & strImgName & strImgExt
    Rename
Next objImg
End If
End Sub
Function DetachImage(ByVal strName As String)
'Function jacked then Bobbed from Luis Alberto who got it somewhere else http://groups.google.com/group/autodesk.autocad.customization.vba/browse_thread/thread/2a3de0506ce1ed32/4e8b16d28d05e7a2%234e8b16d28d05e7a2?sa=X&oi=groupsr&start=0&num=3
On Error GoTo NoPicYo
Dim objImgDic As AcadDictionary
Dim objImg As AcadObject

Set objImgDic = ThisDrawing.Dictionaries("ACAD_IMAGE_DICT")
Set objImg = objImgDic(strName)
objImg.Delete
Bounce:
Exit Function
NoPicYo:
Set objImgDic = Nothing
Set objImg = Nothing
End Function

李唐帝国 发表于 2006-3-15 14:08:40

它在重命名时崩溃？？？

傻子 发表于 2006-3-15 14:15:41

哦，对不起，把线拿开。

微笑 发表于 2006-3-15 14:17:45

奇怪，不确定。我过一会儿会玩它。那又快又脏，我不得不在CPU和设置我的新绘图仪的技术人员之间来回切换。

雯婕影音 发表于 2006-3-15 14:22:43

我想这可能与dwg中的单位设置为英尺有关。我在2006年，所以我必须确保插入单元设置正确
不过，感谢您的代码，它的工作原理很好，这是一个简单的修复

同名同姓 发表于 2006-3-15 14:23:13

它看起来就像是对新图像引用的随机名称，这就是重命名开始之前开始的，因为我决定让你担心这一点。 甚至没有想到插入单元。 它可能更干净，但在我得到你的答案之前，我已经完成了大约一半。 开始使它更通用，然后在最后切到更具体。

查看完整版本: VBA图像控制