Jeff and Tim,
Thank you very much, this is a great start. Unfortunately, the code is a bit
above my head at the moment, so I may have to put off trying to modify it to
work for picked layers only - but if anyone could point me in the right
direction (or modify the code, if it isn't too hard), that would be
excellent. I think this tool would be very useful
Thanks again guys,
Brent McAnney
"Jeff Mishler" wrote in message
news:4944281@discussion.autodesk.com...
To use ObjectDBX in 2000/2002 just remove the .16 in the GetInterfaceObject
line.
And you must make sure it is registered with Windows:
(if (not (vl-registry-read
"HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"))
(startapp "regsvr32.exe" (strcat "/s \"" (findfile "axdb15.dll") "\""))
)
HTH,
Jeff
wrote in message news:4944220@discussion.autodesk.com...
As far as I can go, yes. You can use ObjectDBX in the later versions, but I
don't have the code to do it. If someone can post code to modify my code,
then it can be all good. I can post the code as a learning tool for you
though.
This code works as is here. I cannot guarantee anything.
Tim
(defun c:SetOrigLayerProps (/ ActDoc LayCol BlkCol Obj Name DwgPath ErrChk
dbxRtn dbxLayCol tmpLayName tmpLay tmpEnt)
; Sets color and linetype to match the original drawing.
; First trys to make the linetype match whats in the drawing, if it's not in
the drawing,
; then it matches it back to the xref drawing file.
; Subs 'tmw:OpenDBX 'tmw:CloseDBX 'MakeX
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq LayCol (vla-get-Layers ActDoc))
(setq BlkCol (vla-get-Blocks ActDoc))
(setvar "errno" 0)
(while (/= (getvar "errno") 52)
(if
(and
(setq tmpEnt (entsel "\nSelect Xref to copy back original layer
properties: "))
(setq Obj (MakeX (car tmpEnt)))
(= (vla-get-ObjectName Obj) "AcDbBlockReference")
(= (vla-get-IsXref (vla-Item BlkCol (vla-get-Name Obj))) :vlax-true)
)
(progn
(setq Name (vla-get-Name Obj))
(setq DwgPath (vla-get-Path Obj))
(if (= (strcase DwgPath) (strcase (strcat (vl-filename-base DwgPath)
".dwg")))
(setq DwgPath (strcat (getvar "dwgprefix") DwgPath))
)
(setq dbxRtn (tmw:OpenDBX DwgPath))
(setq dbxLayCol (vla-get-Layers (car dbxRtn)))
(vlax-for Lay dbxLayCol
(setq LayName (vla-get-Name Lay))
(if (and (not (vl-string-search "|" LayName)) (/= LayName "0") (/=
(strcase LayName) "DEFPOINTS"))
(progn
(setq tmpLayName (strcat Name "|" LayName))
(setq tmpLay (vla-Item LayCol tmpLayName))
(vla-put-Color tmpLay (vla-get-Color Lay))
(setq ErrChk (vl-catch-all-apply 'vla-put-Linetype (list tmpLay
(vla-get-Linetype Lay))))
(if (vl-catch-all-error-p ErrChk)
(vl-catch-all-apply 'vla-put-Linetype (list tmpLay (strcat Name "|"
(vla-get-LineType Lay))))
)
)
)
)
(tmw:CloseDBX dbxRtn T)
)
(prompt "\n No X-ref selected.")
)
)
(princ)
)
(defun tmw:OpenDBX (FileName / NewFileName TestIf dbxDoc)
(if FileName
(progn
(if (setq TestIf (open FileName "a"))
(close TestIf)
(progn
(setq NewFileName (strcat (vl-filename-directory FileName) "\\" (strcat
"CopyOf-" (vl-filename-base FileName) ".dwg")))
(if (not (vl-file-copy FileName NewFileName))
(progn
(setq NewFileName (strcat "c:\\" (strcat "CopyOf-" (vl-filename-base
FileName) ".dwg")))
(vl-file-copy FileName NewFileName)
)
)
(setq FileName NewFileName)
)
)
(setq dbxDoc (vla-GetInterfaceObject (vlax-get-ACAD-Object)
"ObjectDBX.AxDbDocument.16"))
(vla-Open dbxDoc FileName)
(list dbxDoc FileName)
)
)
)
;-------------------------------------------------------------------
(defun tmw:CloseDBX (Results EraseFile / FileName)
(setq FileName (cadr Results))
(vlax-Release-Object (car Results))
(if
(and
(= EraseFile T)
(vl-string-search "CopyOf-" (vl-filename-base FileName))
)
(vl-file-delete FileName)
)
)
(defun MakeX (entname)
(vlax-ename->vla-object entname)
)