Change xref colors to match the output file

[cadd4la]

Hi everyone,

I am looking for a lisp that will change the colors, linetypes, etc of the original file to match the colors, linetypes, etc of the file that it is xref into.

Thank

[Stefan BMR]

Try this. It matches color, linetype, lineweight and plottable status.

(defun c:setxlayer ( /
                    xlayer  ; ename of layer to be evaluate
                    xl      ; xlayer dxf lis
                    xname   ; Xref layer name
                    cname   ; current dwg layer name matching xname
                    clayer  ; cname's ename
                    cl      ; current dwg layer's dxf list
                    )            
  (while
    (setq xlayer (tblnext "layer" (not xlayer)))
    (if
      (= 16 (logand 16 (cdr (assoc 70 (setq xl (entget (tblobjname "layer" (cdr (assoc 2 xlayer)))))))))
      (progn
        (setq xname (cdr (assoc 2 xl))
              cname (substr xname (+ 2 (vl-string-position 124 xname))))
        (if
          (setq clayer (tblsearch "layer" cname))
          (progn
            (setq cl (entget (tblobjname "layer" (cdr (assoc 2 clayer))))) 
            (entmod
              (mapcar
                (function
                  (lambda (a)
                    (cond
                      ((= (car a) 62)
                       (cons 62 (if
                                  (minusp (cdr a))
                                  (- (abs (cdr (assoc 62 cl))))
                                  (abs (cdr (assoc 62 cl)))
                                  )
                       ))
                      ((member (car a) '(6 290 370)) (assoc (car a) cl))
                      (T a)
                    )
                  )
                )
              xl
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

[BlackBox]

Try this. It matches color, linetype, lineweight and plottable status.

(defun c:setxlayer ( /
                    xlayer  ; ename of layer to be evaluate
                    xl      ; xlayer dxf lis
                    xname   ; Xref layer name
                    cname   ; current dwg layer name matching xname
                    clayer  ; cname's ename
                    cl      ; current dwg layer's dxf list
                    )            
  (while
    (setq xlayer (tblnext "layer" (not xlayer)))
    (if
      (= 16 (logand 16 (cdr (assoc 70 (setq xl (entget (tblobjname "layer" (cdr (assoc 2 xlayer)))))))))
      (progn
        (setq xname (cdr (assoc 2 xl))
              cname (substr xname (+ 2 (vl-string-position 124 xname))))
        (if
          (setq clayer (tblsearch "layer" cname))
          (progn
            (setq cl (entget (tblobjname "layer" (cdr (assoc 2 clayer))))) 
            (entmod
              (mapcar
                (function
                  (lambda (a)
                    (cond
                      ((= (car a) 62)
                       (cons 62 (if
                                  (minusp (cdr a))
                                  (- (abs (cdr (assoc 62 cl))))
                                  (abs (cdr (assoc 62 cl)))
                                  )
                       ))
                      ((member (car a) '(6 290 370)) (assoc (car a) cl))
                      (T a)
                    )
                  )
                )
              xl
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

What about Layer Transparency?



Also, it may be worth prompting using if these changes will be temporary, in the event that VISRETAIN == 0.

Cheers

[Stefan BMR]

What about Layer Transparency?

Also, it may be worth prompting using if these changes will be temporary, in the event that VISRETAIN == 0.
Cheers

Layer transparency? I saw it coming... Hoped OP doesn't need it.

(defun c:setxlayer ( /
                    xlayer  ; ename of layer to be evaluate
                    xl      ; xlayer dxf lis
                    xname   ; Xref layer name
                    cname   ; current dwg layer name matching xname
                    clayer  ; cname's ename
                    cl      ; current dwg layer's dxf list
                    layer_transparency
                    )            
  (while
    (setq xlayer (tblnext "layer" (not xlayer)))
    (if
      (= 16 (logand 16 (cdr (assoc 70 (setq xl (entget (tblobjname "layer" (cdr (assoc 2 xlayer)))))))))
      (progn
        (setq xname (cdr (assoc 2 xl))
              cname (substr xname (+ 2 (vl-string-position 124 xname))))
        (if
          (setq clayer (tblsearch "layer" cname))
          (progn
            (setq cl (entget (tblobjname "layer" (cdr (assoc 2 clayer))) '("AcCmTransparency")))
            (if
              (setq layer_transparency (assoc -3 cl))
              (entmod (append xl (list layer_transparency)))
              )
            (entmod
              (mapcar
                (function
                  (lambda (a)
                    (cond
                      ((= (car a) 62)
                       (cons 62 (if
                                  (minusp (cdr a))
                                  (- (abs (cdr (assoc 62 cl))))
                                  (abs (cdr (assoc 62 cl)))
                                  )
                       ))
                      ((member (car a) '(6 290 370)) (assoc (car a) cl))
                      (T a)
                    )
                  )
                )
              xl
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

[BlackBox]

Layer transparency? I saw it coming... Hoped OP doesn't need it.

(defun c:setxlayer ( /
                    xlayer  ; ename of layer to be evaluate
                    xl      ; xlayer dxf lis
                    xname   ; Xref layer name
                    cname   ; current dwg layer name matching xname
                    clayer  ; cname's ename
                    cl      ; current dwg layer's dxf list
                    layer_transparency
                    )            
  (while
    (setq xlayer (tblnext "layer" (not xlayer)))
    (if
      (= 16 (logand 16 (cdr (assoc 70 (setq xl (entget (tblobjname "layer" (cdr (assoc 2 xlayer)))))))))
      (progn
        (setq xname (cdr (assoc 2 xl))
              cname (substr xname (+ 2 (vl-string-position 124 xname))))
        (if
          (setq clayer (tblsearch "layer" cname))
          (progn
            (setq cl (entget (tblobjname "layer" (cdr (assoc 2 clayer))) '("AcCmTransparency")))
            (if
              (setq layer_transparency (assoc -3 cl))
              (entmod (append xl (list layer_transparency)))
              )
            (entmod
              (mapcar
                (function
                  (lambda (a)
                    (cond
                      ((= (car a) 62)
                       (cons 62 (if
                                  (minusp (cdr a))
                                  (- (abs (cdr (assoc 62 cl))))
                                  (abs (cdr (assoc 62 cl)))
                                  )
                       ))
                      ((member (car a) '(6 290 370)) (assoc (car a) cl))
                      (T a)
                    )
                  )
                )
              xl
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

Wonder what would happen if there were multiple XREFs with same layers, but different settings?

I sure hope they don't need UNDO functionality either.

[Stefan BMR]

Wonder what would happen if there were multiple XREFs with same layers, but different settings?

It seems to me you didn't test it...

I sure hope they don't need UNDO functionality either.

My mistake. I'll update, if necessary.

[BlackBox]

It seems to me you didn't test it...

Incorrect; to clarify, see the bottom of this post.

My mistake. I'll update, if necessary.

You've done well so far, add only what you're willing to.

Cheers