TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: daron on October 12, 2004, 01:16:11 PM
-
Recently, my employ went and upgraded their servers. Yeah for them. They decided that it would not be too much of a headache to go ahead and change the name of the root directory in the server. Here is the problem. My group (division) attaches images everywhere. We also have a few xrefs. I've been trying to remove the old path name from a given point and replace it with the new path name to that given point. I have all the details worked out, but for some reason vla-put-ImageFile won't work.
(vl-catch-all-apply
'(foreach item objects
(if (vlax-property-available-p item 'ImageFile)
(setq filename (vla-get-imagefile item)
path (newpath filename)
)
(vlax-put-property item 'ImageFile path)
)
))
The catch all helps for trapping, but it seems to stop the iteration on the first error. Without the catch all, I get a file access error. Can someone help?
-
How about something like this;
(setq mspace
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object)
)
)
)
(setq new_path "c:\\Temp\\src\\")
(vlax-for item mspace
(if (= (vla-get-objectname item) "AcDbRasterImage")
(if (vlax-property-available-p item 'ImageFile)
(progn
(setq img_file_name
(strcat
(vl-filename-base (vla-get-ImageFile item))
(vl-filename-extension (vla-get-ImageFile item))
)
)
(vla-put-imagefile
item
(strcat new_path img_file_name)
)
)
)
)
)
-
Daron
I can't make your vl-catch-all-apply work at all.
-
Daron
I can't make your vl-catch-all-apply work at all.
never mind ............ :roll:
-
I think the problem is that I'm currently accessing the links, even though they are broken. Would it work better in vba and if not, would it be possible with objectdbx and does anybody know how to formulate something like this in dbx?
For those interested in dbx, here's something I got from vbdesign on the subject. It most likely won't work right out, but should give a start in it. I for one don't yet understand it.
Option Explicit
Const ATTR_DIRECTORY = 16
Dim objAcad As AcadApplication
Public Sub main()
Dim FileArray As Variant
Dim strDir As String
Dim i As Integer
'acad must be running
Set objAcad = GetObject(, "AutoCAD.Application")
strDir = "P:\Temp\test" 'your dir goes here
FileArray = GetFilesInDir(strDir)
For i = 0 To UBound(FileArray)
OpenAndDoStuff strDir & FileArray(i)
Next i
MsgBox i & " Files Processed"
End Sub
Public Function GetFilesInDir(pDir As String) As Variant
Dim dirReturn As String
Dim subFiles As String
Dim intLen As Integer
Dim intCount As Integer
Dim varRet() As Variant
intLen = Len(pDir)
If Mid(pDir, intLen, 1) <> "\" Then
pDir = pDir & "\"
End If
dirReturn = Dir(pDir & "*.dwg")
'First we find all of the subdirs
Do While dirReturn <> ""
DoEvents
If GetAttr(pDir & dirReturn) <> ATTR_DIRECTORY Then
' that is NOT a dir so add it to listbox
subFiles = dirReturn
ReDim Preserve varRet(0 To intCount)
varRet(intCount) = subFiles
intCount = intCount + 1
End If
dirReturn = Dir
Loop
GetFilesInDir = varRet
End Function
Private Function OpenAndDoStuff(strFileName As String) As Variant
Dim objDbx As Object
Dim i As Integer
Dim objAcadEnt As AcadEntity
Dim objBlockRef As AcadBlockReference
Dim objLayer As AcadLayer
Dim strSearchBlckName As String
Dim dblSearchScale As Double
Dim dblCurrScale As Double
Dim dblNewScale As Double
Dim basePt(0 To 2) As Double
On Error GoTo Err_Control
'set up search parameters. these should be passed in as args
dblSearchScale = 48#
strSearchBlckName = "borsiv36"
Set objDbx = objAcad.GetInterfaceObject("ObjectDBX.AxDbDocument")
objDbx.Open strFileName
i = 0
For Each objAcadEnt In objDbx.ModelSpace
If TypeName(objAcadEnt) = "IAcadBlockReference" Then
Set objBlockRef = objAcadEnt
If objBlockRef.Name = "borsiv36" Then
dblCurrScale = objBlockRef.XScaleFactor
Exit For ' assumes only one block of borsiv36 in file
End If
End If
Next objAcadEnt
If dblCurrScale <> dblSearchScale Then
dblNewScale = dblSearchScale / dblCurrScale 'set up the scale-by factor
'just in case layers are locked, unlock them
For Each objLayer In objDbx.Layers
objLayer.Lock = False
Next objLayer
'scale all the modelspace entities by the new factor
For Each objAcadEnt In objDbx.ModelSpace
objAcadEnt.ScaleEntity basePt, dblNewScale
Next objAcadEnt
objDbx.SaveAs strFileName
Else
objDbx.SaveAs strFileName
End If
Debug.Print "Finished " & strFileName
Set objDbx = Nothing
Exit_Here:
Exit Function
Err_Control:
MsgBox Err.Description
Set objDbx = Nothing
Resume Exit_Here
End Function
Option Explicit
Public FileInfo() As String
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Public Const MAX_PATH = 2600
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Public Sub BatchDBX()
Dim frmDBX As New UserForm1
frmDBX.Show
Set frmDBX = Nothing
End Sub
Public Function ReturnFolder(lngHwnd As Long) As String
Dim Browser As BROWSEINFO
Dim lngFolder As Long
Dim strPath As String
With Browser
.hOwner = lngHwnd
.lpszTitle = "Select Directory to work in"
.pszDisplayName = String(MAX_PATH, 0)
End With
strPath = String(MAX_PATH, 0) '<-- VERY Important!!
lngFolder = SHBrowseForFolder(Browser)
If lngFolder Then
SHGetPathFromIDList lngFolder, strPath
ReturnFolder = Left(strPath, InStr(strPath, vbNullChar) - 1)
End If
End Function
Public Function ParseOut(strIn As String, strChar As String) As String
Dim intCnt As Integer
Dim strFile As String
intCnt = 1
Do
If Mid(strIn, intCnt, 1) = strChar Then
strFile = Mid(strIn, 1, intCnt - 1)
strIn = Mid(strIn, intCnt + 1, Len(strIn))
ParseOut = strFile
Exit Function
End If
intCnt = intCnt + 1
Loop
End Function
-
This seems to work for the time being. I still have to make it accept xrefs. We'll see how it goes tomorrow. I'm out for the day. Here's a new snippet.
(vl-catch-all-apply
'(mapcar
'(lambda (x)
(if (vlax-property-available-p x 'ImageFile)
(progn
(setq filename (vla-get-imagefile x)
path (newpath filename)
)
(vlax-put-property
x
'ImageFile
path
)
)
)
)
objects
)
objects
)
-
How would one get this to work for images in a Layout Tab named "00" (no quotations)?
How about something like this;
(setq mspace
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object)
)
)
)
(setq new_path "c:\\Temp\\src\\")
(vlax-for item mspace
(if (= (vla-get-objectname item) "AcDbRasterImage")
(if (vlax-property-available-p item 'ImageFile)
(progn
(setq img_file_name
(strcat
(vl-filename-base (vla-get-ImageFile item))
(vl-filename-extension (vla-get-ImageFile item))
)
)
(vla-put-imagefile
item
(strcat new_path img_file_name)
)
)
)
)
)
-
Just cycle through the layout collection. When you find the one you want, assign the variable ' mspace ' to the layout object.
(vlax-for i (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= (vla-get-Name i) "LayoutNameHere")
(vlax-for j (vla-get-Block i) [color=red]; <-- This line equals ' (vlax-for item mspace ' in the code below.[/color]
.... do the magic here ...
)
)
)
Edit: You can check here also.
[ http://www.theswamp.org/index.php?topic=26834.0 ]
How would one get this to work for images in a Layout Tab named "00" (no quotations)?
How about something like this;
(setq mspace
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object)
)
)
)
(setq new_path "c:\\Temp\\src\\")
(vlax-for item mspace
(if (= (vla-get-objectname item) "AcDbRasterImage")
(if (vlax-property-available-p item 'ImageFile)
(progn
(setq img_file_name
(strcat
(vl-filename-base (vla-get-ImageFile item))
(vl-filename-extension (vla-get-ImageFile item))
)
)
(vla-put-imagefile
item
(strcat new_path img_file_name)
)
)
)
)
)
-
Just cycle through the layout collection. When you find the one you want, assign the variable ' mspace ' to the layout object.
(vlax-for i (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= (vla-get-Name i) "00")
(vlax-for j (vla-get-Block i) [color=red]; <-- This line equals ' (vlax-for item mspace ' in the code below.[/color]
.... do the magic here ...
)
)
)
This returns NIL when I run it on a drawing with images in a layout named "00". Shouldn't it return the name of the layout?
-
Just cycle through the layout collection. When you find the one you want, assign the variable ' mspace ' to the layout object.
(vlax-for i (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= (vla-get-Name i) "00")
(vlax-for j (vla-get-Block i) [color=red]; <-- This line equals ' (vlax-for item mspace ' in the code below.[/color]
.... do the magic here ...
)
)
)
This returns NIL when I run it on a drawing with images in a layout named "00". Shouldn't it return the name of the layout?
That should error, since it doesn't know how to interpret the ' ... ', but if you placed the code, then a nil is okay, as that is what is returned by a lot of ActiveX stuff in Lisp.
-
Sorry, but it's been a while since I've coded, not sure where to separate things here. This is what I've got, and am getting a "error: bad argument type: stringp nil" message when I run it.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;start prog
(defun c:im_upd2 ()
(setq new_path (GETVAR "DWGPREFIX"))
(vlax-for i (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= (vla-get-Name i) "00")
(progn
(vlax-for item (vla-get-Block i)
(if (= (vla-get-objectname item) "AcDbRasterImage")
(if (vlax-property-available-p item 'ImageFile)
(progn
(setq img_file_name
(strcat
(vl-filename-base (vla-get-ImageFile item))
(vl-filename-extension (vla-get-ImageFile item))
)
)
(vla-put-imagefile
item
(strcat new_path img_file_name)
)
)
)
)
)
)
)
)
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;defun---End Prog
Sorry for being such a pain...
-
It worked for me. The only thing I can think of is if the file name is not set, so you are getting a nil for that. Code just re-formated.
(defun c:im_upd2 ()
(setq new_path (GETVAR "DWGPREFIX"))
(vlax-for i (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= (vla-get-Name i) "00")
(vlax-for item (vla-get-Block i)
(if (= (vla-get-objectname item) "AcDbRasterImage")
(if (vlax-property-available-p item 'ImageFile)
(progn
(setq img_file_name
(strcat
(vl-filename-base (vla-get-ImageFile item))
(vl-filename-extension (vla-get-ImageFile item))
)
)
(vla-put-imagefile
item
(strcat new_path img_file_name)
)
)
)
)
)
)
)
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;defun---End Prog
-
Drawing is named, and 4 raster files reside in a layout named "00".
Here's my situation, we have quite a few drawings with images pathed to c:\documents and settings\administrator\... (yeah, I know), and I want to strip out the "documents and settings\administrator" part of it. I've never dealt with images or ActiveX stuff before, so I'm just looking for a quick solution on this. Got anything that would do that?
-
Bahhh...
I'll just use the Ref Manager for now...
-
I just couldn't leave it til I got something to work. This is cludgy, but effective:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;start prog
(defun c:im_upd2 ()
(vl-load-com)
(setq new_path (GETVAR "DWGPREFIX"))
(vlax-for i (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= (vla-get-Name i) "00")
(vlax-for item (vla-get-Block i)
(if (= (vla-get-objectname item) "AcDbRasterImage")
(if (vlax-property-available-p item 'ImageFile)
(progn
(setq img_file_name01
(strcat
(vl-filename-base (vla-get-ImageFile item))
(vl-filename-extension (vla-get-ImageFile item))
)
)
(setq img_file_name02
(strcat
(vl-filename-base (vla-get-ImageFile item))
)
)
(setq im_full (strcat new_path img_file_name01))
;(print im_full)
(command "-image" "p" img_file_name02 im_full)
)
)
)
)
)
)
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;defun---End Prog
Thank you very much for the help T-Dubya.
-
You're welcome Deegs. Could you post one of the drawings? No need for the images, I just want to see if I can get them to repath with the code, as it was working here.
You can do this type of thing with ObjectDBX, so you could run through a folder pretty quickly. Could be done in any language your comfortable with also.
I'm glad you got something, but you shouldn't have to resort to ' command ' calls. :wink:
-
You're welcome Deegs. Could you post one of the drawings? No need for the images, I just want to see if I can get them to repath with the code, as it was working here.
I would, but there's way too much proprietary info on them. I was getting an error saying that the file couldn't be accessed, could be that it wasn't released from the first run through...
You can do this type of thing with ObjectDBX, so you could run through a folder pretty quickly. Could be done in any language your comfortable with also.
Yes, I have some ODBX code for VBA, but it's been quite a few years since I've dived into coding, and I needed something quick. <---------Boilerplate Disclaimer
I'm glad you got something, but you shouldn't have to resort to ' command ' calls. :wink:
Hehe, I'm just a hack.
-
Cool. I understand. Next time try this little diddy. I made the variables local, and have it print the old path and the new path per image file, so that you can see if it does change it or not.
(defun c:im_upd2 (/ new_path img_file_name)
(setq new_path (GETVAR "DWGPREFIX"))
(vlax-for i (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= (vla-get-Name i) "00")
(vlax-for item (vla-get-Block i)
(if
(and
(= (vla-get-objectname item) "AcDbRasterImage")
(vlax-property-available-p item 'ImageFile)
)
(progn
(setq img_file_name
(strcat
(vl-filename-base (vla-get-ImageFile item))
(vl-filename-extension (vla-get-ImageFile item))
)
)
(print (vla-get-ImageFile item))
(vla-put-imagefile
item
(strcat new_path img_file_name)
)
(print (vla-get-ImageFile item))
)
)
)
)
)
(princ)
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;defun---End Prog
-
error: Automation Error. File access error
:?
I'm using 04 btw...
-
error: Automation Error. File access error
:?
I'm using 04 btw...
Post the whole error message with this one.
(defun c:im_upd2 (/ new_path img_file_name *error*)
(defun *error* (msg) (vl-bt))
(setq new_path (GETVAR "DWGPREFIX"))
(vlax-for i (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= (vla-get-Name i) "00")
(vlax-for item (vla-get-Block i)
(if
(and
(= (vla-get-objectname item) "AcDbRasterImage")
(vlax-property-available-p item 'ImageFile)
)
(progn
(setq img_file_name
(strcat
(vl-filename-base (vla-get-ImageFile item))
(vl-filename-extension (vla-get-ImageFile item))
)
)
(print (vla-get-ImageFile item))
(vla-put-imagefile
item
(strcat new_path img_file_name)
)
(print (vla-get-ImageFile item))
)
)
)
)
)
(princ)
);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;defun---End Prog
Don't think that should be an issue with this.
-
It was erroring from an image file that has a different path altogether, once I detached it all is well. I'll have to add an exclusion for that image, as it's a part of our title blocks, and add something for missing files as well for this to work in variable situations.
-
It may not work if there is no file at the new path, so you can just check to see if the new path exist, ' findfile ', and if so, then repath it. If not, print it to the command line that the new path was not found... yada yada yada.
-
Yes sir, I'll post the code when I get it to work "Correctly".
-
Xref & Images paths (http://www.cadtutor.net/forum/showthread.php?p=136551#post136551)