Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Reply
Distinguished Contributor
BMcAnney
Posts: 406
Registered: ‎12-09-2003
Message 1 of 22 (108 Views)

Check original color of layer in xref

108 Views, 21 Replies
08-31-2005 08:34 AM
Hello all,

I am looking for a way to access the original color of a layer an xref
drawing. For example, you have an xref in your drawing. In the drawing you
change the xref layer color to something else. What I want is to access the
original color, as it stands in the xref drawing currently.

Once I can do this, my goal is to create a quick lisp that will let me pick
a particular layer, and restore it to it's default xref color. Kind of like
setting VISRETAIN to zero for that particular layer, temporarily.

Anyone know how I would go about this?

Thanks!
Brent McAnney
Mentor
t.willey
Posts: 2,504
Registered: ‎02-17-2004
Message 2 of 22 (108 Views)

Re: Check original color of layer in xref

08-31-2005 08:43 AM in reply to: BMcAnney
The only way I can think of is to use ObjectDBX. I have one that changes all the layers back to the original color and linetype, but it will only work with 2004. You can change it to only work with a single pick.

If it's something you think you are interested in, let me know, and I can post it.

Tim
Distinguished Contributor
BMcAnney
Posts: 406
Registered: ‎12-09-2003
Message 3 of 22 (108 Views)

Re: Check original color of layer in xref

08-31-2005 08:47 AM in reply to: BMcAnney
Although I know nothing of ObjectDBX, I am interested. However, we are
currently on 2000 (LD3), and upgrading to 2006 within a week. Am I out of
luck?

Thanks Tim,
Brent

wrote in message news:4944178@discussion.autodesk.com...
The only way I can think of is to use ObjectDBX. I have one that changes
all the layers back to the original color and linetype, but it will only
work with 2004. You can change it to only work with a single pick.

If it's something you think you are interested in, let me know, and I can
post it.

Tim
Mentor
t.willey
Posts: 2,504
Registered: ‎02-17-2004
Message 4 of 22 (108 Views)

Re: Check original color of layer in xref

08-31-2005 09:05 AM in reply to: BMcAnney
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:smileyfrustrated:etOrigLayerProps (/ 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:smileysurprised:penDBX '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:smileysurprised:penDBX 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:smileysurprised:penDBX (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)
)
*Josh
Message 5 of 22 (108 Views)

Re: Check original color of layer in xref

08-31-2005 09:33 AM in reply to: BMcAnney
Jeff Mishler has(had?) a VBA program to do this that's called
XREF-SYNC...pretty nifty. You'll have to search the NGs or contact him to
get it.

wrote in message news:4944152@discussion.autodesk.com...
Hello all,

I am looking for a way to access the original color of a layer an xref
drawing. For example, you have an xref in your drawing. In the drawing you
change the xref layer color to something else. What I want is to access the
original color, as it stands in the xref drawing currently.

Once I can do this, my goal is to create a quick lisp that will let me pick
a particular layer, and restore it to it's default xref color. Kind of like
setting VISRETAIN to zero for that particular layer, temporarily.

Anyone know how I would go about this?

Thanks!
Brent McAnney
*Jeff Mishler
Message 6 of 22 (108 Views)

Re: Check original color of layer in xref

08-31-2005 09:35 AM in reply to: BMcAnney
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:smileyfrustrated:etOrigLayerProps (/ 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:smileysurprised:penDBX '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:smileysurprised:penDBX 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:smileysurprised:penDBX (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)
)
Mentor
t.willey
Posts: 2,504
Registered: ‎02-17-2004
Message 7 of 22 (108 Views)

Re: Check original color of layer in xref

08-31-2005 09:38 AM in reply to: BMcAnney
Thanks Jeff.

Tim
*Jeff Mishler
Message 8 of 22 (108 Views)

Re: Check original color of layer in xref

08-31-2005 09:40 AM in reply to: BMcAnney
Hi Josh,
Thanks for the plug. However, mine changes the colors/linetypes/whatever
globally, not on a per layer basis. Although it could be modified to do so.

Jeff

"Josh" wrote in message
news:4944263@discussion.autodesk.com...
Jeff Mishler has(had?) a VBA program to do this that's called
XREF-SYNC...pretty nifty. You'll have to search the NGs or contact him to
get it.
*Don Ireland
Message 9 of 22 (108 Views)

Re: Check original color of layer in xref

08-31-2005 10:09 AM in reply to: BMcAnney
I would be interested in this as well. On many occasions, I've run in to
the need to do pretty much the same thing. I've sometimes needed to do it
on all layers and sometimes on a couple layers. I've just never had the
time to sit down and try.

Maybe a good revision would be to have it take an argument which would be
the layer(s) to modify. You could specify * for all layers. Then if you
wanted to have a command whose only purpose was to change ALL layers, you
could have a seperate command that called the first one. That way you
wouldn't have double the code.

"Jeff Mishler" wrote in message
news:4944283@discussion.autodesk.com...
Hi Josh,
Thanks for the plug. However, mine changes the colors/linetypes/whatever
globally, not on a per layer basis. Although it could be modified to do so.

Jeff

"Josh" wrote in message
news:4944263@discussion.autodesk.com...
Jeff Mishler has(had?) a VBA program to do this that's called
XREF-SYNC...pretty nifty. You'll have to search the NGs or contact him to
get it.
Distinguished Contributor
BMcAnney
Posts: 406
Registered: ‎12-09-2003
Message 10 of 22 (108 Views)

Re: Check original color of layer in xref

08-31-2005 10:19 AM in reply to: BMcAnney
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:smileyfrustrated:etOrigLayerProps (/ 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:smileysurprised:penDBX '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:smileysurprised:penDBX 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:smileysurprised:penDBX (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)
)
Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Announcements
Do you have 60 seconds to spare? The Autodesk Community Team is revamping our site ranking system and we want your feedback! Please click here to launch the 5 question survey. As always your input is greatly appreciated.