Temporarily change all xref colors only for plotting!

[SergeM]

Hello experts,

Thanks to Jason Piercy i got the following lisp:

(defun c:adjustXref (/ lst ename object name)
(setvar "errno" 0)
(while (/= 52 (getvar "errno"))
(setq lst (entsel "\nselect an xref : "))
(cond
((= 7 (getvar "errno"))
(princ "\nMiss pick")
(setvar "errno" 0) )
((and
lst
(setq ename (car lst))
(setq object (vlax-ename->vla-object ename))
(vlax-property-available-p object 'path)
)
(setq name (vla-get-name object))
(command "layer" "c" 252 (strcat name "|*") "" "")
(command "draworder" ename "" "back")
)
(lst (princ "\nselection was not an xref"))
(t (setvar "errno" 52))
)
)
(princ)
)

Is it possible to complete this lisp for dimtext colors, attribute text

colors, and text colors???

After the xref is reloaded and/or the host drawing is reopened the xref(s) have to stay the same of course.

 

Sorry for the not coded lisp that came in my thread wich i posted earlier.

Thanks Serge

[SergeM]

From Articad i got this tip (visual basic), can someone help me further on?

 

 
You could just set an undo mark. 
ThisDrawing.StartUndoMark
' do some code
ThisDrawing.EndUndoMark
' do something
DoEvents
' Then set everything back to where it was. 
ThisDrawing.SendCommand (Chr(27) & Chr(27)) & "undo" & vbCr & "1" & vbCr & Chr(27)
Also here is an Example of how to store info in Xrecords and Retrieve them.
It will store a single value and it's property.

Sub StoreXdata(item As Variant, Text As String, value As Variant)
Dim xdataType(0 To 1) As Integer, xdata(0 To 1) As Variant

   xdataType(0) = 1001: xdata(0) = Text
   xdataType(1) = 1000: xdata(1) = value
   If ThisDrawing.layers(item.layer).Lock = False Then
       item.SetXdata xdataType, xdata
   Else
       UnLockLayer item.layer
           item.SetXdata xdataType, xdata
       LockLayer item.layer
   End If

End Sub


Function RetrieveXdata(item As Variant, Text As String) As Variant

If TypeOf item Is AcadPViewport Or _
TypeOf item Is AcadViewport Or _
TypeOf item Is AcadModelSpace Or _
TypeOf item Is AcadPaperSpace Then Exit Function

   Dim xdataOut As Variant
   Dim xtypeOut As Variant
   item.GetXData "", xtypeOut, xdataOut
   If isValid(xdataOut) Then
       For i = LBound(xdataOut) To UBound(xdataOut)
           If Not isValid(xdataOut(i)) Then
           If UCase(xdataOut(i)) = UCase(Text) Then
               If Not i + 1 > UBound(xdataOut) Then
                   RetrieveXdata = xdataOut(i + 1)
                   Exit For
               End If
           End If
           End If
       Next
   End If

End Function


Function isValid(myarray As Variant) As Boolean
On Error GoTo theend
Dim i As Variant
   For Each i In myarray
       isValid = True
       Exit Function
   Next
theend:
   isValid = False
End Function

 

Thanks Serge:cry:

[Patrick_35]

Hi

 

Given the number of reply, I will propose a simple solution.

Aggiungi early lisp.

(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))

At the end of lisp.

(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))

And then to return to the state's initial drawing

(vl-cmdf "_.undo" "1")

@+

[SergeM]

From Articad i got this tip (visual basic), can someone help me further on?

Is it possible to complete this lisp for dimtext colors, attribute text

colors, and text colors???

After the xref is reloaded and/or the host drawing is reopened the xref(s) have to stay the same of course.

 

 
You could just set an undo mark. 
ThisDrawing.StartUndoMark
' do some code
ThisDrawing.EndUndoMark
' do something
DoEvents
' Then set everything back to where it was. 
ThisDrawing.SendCommand (Chr(27) & Chr(27)) & "undo" & vbCr & "1" & vbCr & Chr(27)
Also here is an Example of how to store info in Xrecords and Retrieve them.
It will store a single value and it's property.

Sub StoreXdata(item As Variant, Text As String, value As Variant)
Dim xdataType(0 To 1) As Integer, xdata(0 To 1) As Variant

   xdataType(0) = 1001: xdata(0) = Text
   xdataType(1) = 1000: xdata(1) = value
   If ThisDrawing.layers(item.layer).Lock = False Then
       item.SetXdata xdataType, xdata
   Else
       UnLockLayer item.layer
           item.SetXdata xdataType, xdata
       LockLayer item.layer
   End If

End Sub


Function RetrieveXdata(item As Variant, Text As String) As Variant

If TypeOf item Is AcadPViewport Or _
TypeOf item Is AcadViewport Or _
TypeOf item Is AcadModelSpace Or _
TypeOf item Is AcadPaperSpace Then Exit Function

   Dim xdataOut As Variant
   Dim xtypeOut As Variant
   item.GetXData "", xtypeOut, xdataOut
   If isValid(xdataOut) Then
       For i = LBound(xdataOut) To UBound(xdataOut)
           If Not isValid(xdataOut(i)) Then
           If UCase(xdataOut(i)) = UCase(Text) Then
               If Not i + 1 > UBound(xdataOut) Then
                   RetrieveXdata = xdataOut(i + 1)
                   Exit For
               End If
           End If
           End If
       Next
   End If

End Function


Function isValid(myarray As Variant) As Boolean
On Error GoTo theend
Dim i As Variant
   For Each i In myarray
       isValid = True
       Exit Function
   Next
theend:
   isValid = False
End Function

 

Thanks Serge:cry:

Hi

 

Given the number of reply, I will propose a simple solution.

Aggiungi early lisp.

(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))

At the end of lisp.

(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))

And then to return to the state's initial drawing

(vl-cmdf "_.undo" "1")

@+

 

Hello Patrick,

 

Can you show me a how this looks completely in visual basic language.

This is what i want it do for me:

 

1) Each nested item have to be checked automatically and the current status of the these nested items have to be saved automatically to an Xrecord.

2) Then set automaticaly all nested colors to color 252 for example.

3) After i plot the drawing or after canceling the plot the default colors of the nested items have to appear again.

 

Can you realize this for me?

 

Pay attention to the fact that i would like to have the program also deal with nested textcolors and attribute colors and hatch colors etc. All the possible colors have to be chanched

temporarily in to the color 252.

 

I hope i don't ask to much of your time.

I think you could be very helpfull to me to deal with this thread.

And i'm sure many other people in this forum agree with me.

 

The reason of mentioning this thread is to provoke some discussions and ideas to finally deal with this thread.

This could be a breakthrough in plotting Xref's!

 

Thanks Serge

[Patrick_35]

Hello,

 

Yes, I am willing to develop a program for you to meet your expectations, but not vba, although I know read it, but vlisp, which in my opinion, is more suited to Autocad.

From what I understand you want all the colors change in just 252 time of the drawing.

You can use a table for that plotter, or use a undo as proposed.

What I do not understand is why you want to intervene in xrecords?

For what purpose?

 

 

@+

[SergeM]

Hello,

 

Yes, I am willing to develop a program for you to meet your expectations, but not vba, although I know read it, but vlisp, which in my opinion, is more suited to Autocad.

From what I understand you want all the colors change in just 252 time of the drawing.

You can use a table for that plotter, or use a undo as proposed.

What I do not understand is why you want to intervene in xrecords?

For what purpose?

 

 

@+

 

Ok Patrick, Forget the visual basic.

I hope you could finish the mentioned lisp for me.

[Patrick_35]

Hello

 

Here is the lisp as promised.

 

(defun c:plt(/ bl cal cmd doc ent *errplt* old_error)

 (defun *errplt* (msg)
   (or (member (strcase msg) '("FUNCTION CANCELLED" ""QUIT / EXIT ABORT"" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
     (princ (strcat "\nErreur : " msg))
   )
   (setq *error* old_error)
   (vla-endundomark doc)
   (vl-cmdf "_.undo" "1")
   (setvar "cmdecho" cmd)
   (princ)
 )

 (setq old_error *error*
   *error* *errplt*
   doc (vla-get-activedocument (vlax-get-acad-object))
   cmd (getvar "cmdecho")
 )
 (setvar "cmdecho" 0)
 (vla-startundomark doc)
 (vlax-for cal (vla-get-layers doc)
   (vla-put-lock cal :vlax-false)
 )
 (vlax-for bl (vla-get-blocks doc)
   (vlax-for ent bl
     (vla-put-color ent 252)
     (and (eq (vla-get-objectname ent) "AcDbBlockReference")
      (eq (vla-get-hasattributes ent) :vlax-true)
   (foreach att (vlax-invoke ent 'getattributes)
     (vla-put-color att 252)
   )
     )
   )
 )
 (and (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke (list (vla-get-plot doc) 'plottodevice)))
   (princ "\nError to plot.")
 )
 (setq *error* old_error)
 (vla-endundomark doc)
 (vl-cmdf "_.undo" "1")
 (setvar "cmdecho" cmd)
 (princ)
)

@+

[SergeM]

Hello Patrick,

 

Nice lisp, but i would like to plot the layers that are not in the xref to be plotted normally. could you do that for me??

 

Thanks Serge