Author Topic: color change xref (select)  (Read 7294 times)

0 Members and 2 Guests are viewing this topic.

au-s

  • Guest
color change xref (select)
« on: October 05, 2010, 08:14:12 AM »
Hi,

I have this simple lisp routine to change xrefs.

Code: [Select]
(defun c:changexrcolor ()
  (command
    "-layer"
    "color"
    (acad_colordlg 1)
    "*|*"   
    "")
 
  )
(princ)

Is that a good routine?

Anyways .. I would like to modify it so that I've got two options.
Change color on ALL xrefs or choose which-ones of the XREFs I can change colors on?

is that possible?


T.Willey

  • Needs a day job
  • Posts: 5251
Re: color change xref (select)
« Reply #1 on: October 05, 2010, 11:22:52 AM »
I've wanted to rewrite this code for awhile, so here you go.  You can type ' all ' when it asks you to select an xref even though it is not shown.

Code: [Select]
(defun c:xr-c(/ ActDoc Sel Clr Data XrName )
    ; Change all the layers of an xref to selected color.
   
    (vl-load-com)
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (initget "All")
    (if
        (and
            (setq Sel (entsel "\n Select xref to change color of all layers: "))
            (setq XrName
                (if (= Sel "All")
                    "*|*"
                    (if
                        (and
                            (setq Data (entget (car Sel)))
                            (= (cdr (assoc 0 Data)) "INSERT")
                            (setq XrName (cdr (assoc 2 Data)))
                            (equal (logand (cdr (assoc 70 (tblsearch "block" XrName))) 4) 4)
                        )
                        (setq XrName (strcat XrName "|*"))
                    )
                )
            )
            (setq Clr (acad_colordlg 252))
        )
        (progn
            (vlax-for i (vla-get-Layers ActDoc)
                (if (wcmatch (vla-get-Name i) XrName)
                    (vla-put-Color i Clr)
                )
            )
            (vla-Regen ActDoc acActiveViewport)
        )
    )
    (vla-EndUndoMark ActDoc)
    (princ)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: color change xref (select)
« Reply #2 on: October 05, 2010, 04:08:04 PM »
I have made some changes based on our needs here. My modifications will allow for changing plot styles of the xrefs (when applicable) and allow for optionally changing nested xrefs as well (thanks to another one of T. Willey's routines). This also allows you to choose multiple xrefs without having to choose all xrefs and the only nested xref layers that will be changed are those that are nested within the selected xrefs, but all instances of that nested xref will be updated.

Code: [Select]
; Original by T.Willey at http://www.theswamp.org/index.php?topic=35168.0
; Modified by cmwade77 to allow for selecting multiple xrefs as well as nested xrefs (as an option) and Plotystyle when available
(defun c:xradjust (/ ActDoc Sel Data XrName xRefs ct i ct2)
    ; Change all the layers of an xref to selected color.   
    (vl-load-com)
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
   (if (= Clr nil)
      (setq Clr 8)
   )
   (if (= nested nil)
      (setq nested "Yes")
   )
   (if (= pstyle nil)
      (setq pstyle "No Change")
   )
   (setq kWord T)
   (while (/= kWord nil)
      (cond
         ((= (getvar "PSTYLEMODE") 0)
            (initget "Color Plotstyle Nested _Color PS Nested")
            (setq kWord (getkword (strcat "\nColor: " (rtos clr 2 0) "/Plotstyle: " pstyle "/Nested: " nested " <Press Enter to Continue>: ")))
         )
         (T
            (initget "Color Nested _Color Nested")
            (setq kWord (getkword (strcat "\nColor: " (rtos clr 2 0) "/Nested: " nested " <Press Enter to Continue>: ")))
         )
      )
      (cond
         ((= kWord "Color")
            (setq Clr (acad_colordlg 8))
         )
         ((= kWord "Nested")
            (initget 1 "Yes No")
            (setq nested (getkword "\nDo you want to include nested xrefs? (Yes/No) "))
         )
         ((= kWord "PS")
            (setq pstyle (getstring T "\nType plotstyle to use (No Change): "))
         )
      )
   )
   (while (= xRefs nil)
      (setq xRefs (ssget))
   )   
   (setq ct 0)
   (while (< ct (sslength xRefs))
      (setq Sel (ssname xRefs ct))     
      (setq ct (+ ct 1)           
           Data (entget Sel))
      (if (= (cdr (assoc 0 Data)) "INSERT")
         (progn
            (setq XrName (cdr (assoc 2 Data)))           
            (cond
               ((= nested "Yes")
                  (setq MyList nil)               
                  (nxr XrName)                 
               )
            )
            (if (equal (logand (cdr (assoc 70 (tblsearch "block" XrName))) 4) 4)
               (vlax-for i (vla-get-Layers ActDoc)                             
                  (if (wcmatch (vla-get-Name i) (strcat XrName "|*"))
                     (progn
                        (vla-put-Color i Clr)
                        (cond
                           ((and (= (getvar "PSTYLEMODE") 0) (/= (strcase pstyle) "NO CHANGE"))
                              (vla-put-plotstylename i pstyle)
                           )
                        )
                     )
                  )
                  (cond
                     ((= nested "Yes")                       
                        (setq ct2 0)
                        (while (< ct2 (length MyList))                                         
                           (if (wcmatch (vla-get-Name i) (strcat (nth ct2 MyList) "|*"))
                              (progn
                                 (vla-put-Color i Clr)
                                 (cond
                                    ((and (= (getvar "PSTYLEMODE") 0) (/= (strcase pstyle) "NO CHANGE"))
                                       (vla-put-plotstylename i pstyle)
                                    )
                                 )
                              )
                           )
                           (setq ct2 (+ ct2 1))
                        )
                     )
                  )
               )
            )
         )
      )     
   )   
    (vla-Regen ActDoc acActiveViewport)
    (vla-EndUndoMark ActDoc)
    (princ)
)
; The code below has been adapted from:
; T. Willey's Code at http://www.theswamp.org/index.php?topic=34277.0
(defun nxr ( xr / GetXrefNesting PrintNestedList )
    ; Prints nested xref tree to command line, no matter how deep the nesting.
    (defun GetXrefNesting (/ GetXrefInfo tempData tempEnt XrefList NonNestedXrefList NestedXrefList )       
        (defun GetXrefInfo ( ent / NestList )
            (foreach i (member '(102 . "{BLKREFS") (entget ent))
                (if (equal (car i) 332)
                    (progn
                        (setq NestedList (cons (cdr i) NestedList))
                        (setq NestList
                            (cons
                                (cons
                                    (cdr i)
                                    (GetXrefInfo (cdr i))
                                )
                                NestList
                            )
                        )
                    )
                )
            )
            NestList
        )
        ;-------------------------------------       
        (while (setq tempData (tblnext "block" (not tempData)))
            (if (equal (logand (cdr (assoc 70 tempData)) 4) 4)
                (progn
                    (setq tempEnt (tblobjname "block" (cdr (assoc 2 tempData))))
                    (setq tempEnt (cdr (assoc 330 (entget tempEnt))))
                    (setq XrefList
                        (cons
                            (cons
                                tempEnt
                                (GetXrefInfo tempEnt)
                            )
                            XrefList
                        )
                    )
                )
            )
        )
        (foreach i XrefList
            (if (not (member (car i) NestedList))
                (setq NonNestedXrefList (cons i NonNestedXrefList))
            )
        )
        NonNestedXrefList
    )
    ;------------------------------------------------
    (defun PrintNestedList ( lst spc )
        (foreach
            i
            (vl-sort
                lst
                (function
                    (lambda ( a b )
                        (<
                            (strcase (cdr (assoc 2 (entget (car a)))))
                            (strcase (cdr (assoc 2 (entget (car b)))))
                        )
                    )
                )
            )
         (setq NX (cdr (assoc 2 (entget (car i)))))
         (if (= MyList nil)           
               (setq MyList (list NX))
               (setq MyList (append MyList (list NX)))
         )
            ;(prompt (strcat "\n" spc " Nested xref: " (cdr (assoc 2 (entget (car i))))))
            (PrintNestedList (cdr i) (strcat "  " spc))
         
            ;(PrintNestedList (cdr i) (strcat "  |" spc)) ; second option shown below
        )
    )
    ;-----------------------------------------------------       
   (foreach
        i
        (vl-sort
            (GetXrefNesting)
            (function
                (lambda ( a b )
                    (<
                        (strcase (cdr (assoc 2 (entget (car a)))))
                        (strcase (cdr (assoc 2 (entget (car b)))))
                    )
                )
            )
        )
      (if (= xr (cdr (assoc 2 (entget (car i)))))
         (progn
            ;(prompt (strcat "\n Main xref: " (cdr (assoc 2 (entget (car i))))))
            (PrintNestedList (cdr i) "  |-")
         )
      )
    )
    (princ)
)

<edit CAB: replaced tabs with 3 spaces>
« Last Edit: October 08, 2010, 11:15:53 AM by CAB »

VVA

  • Newt
  • Posts: 166
Re: color change xref (select)
« Reply #3 on: October 06, 2010, 02:21:16 PM »
My Variant
Code: [Select]
(defun C:COLORXLAY (/ doc col xreflist ret)
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for item (vla-get-Blocks doc)
      (if (= (vla-get-IsXref item) :vlax-true)
         (setq xreflist (cons (vla-get-name item) xreflist))
        )
    )
  (if xreflist
  (if (and (setq ret (_dwgru-get-user-dcl "Select XREF " (acad_strlsort xreflist) t))
           (setq col (acad_colordlg 7 nil))
           )
    (progn
      (setq ret (apply 'strcat (mapcar '(lambda(x)(strcat x "|*,")) ret)))
    (vla-startundomark doc)
    (vlax-for item (vla-get-Layers doc)
      (if (wcmatch (vla-get-name item) ret)
(vla-put-color item col)
      )
      )
        (vla-endundomark doc)
    )
  ) ;_ end of if
    (alert "No XREF Found")
    )
  (princ)
) ;_ end of defun

;;; ************************************************************************
;;; * Library DWGruLispLib Copyright © 2008 DWGru Programmers Group
;;; *
;;; * _dwgru-get-user-dcl (Candidate)
;;; *
;;; * Inquiry of value at the user through a dialogue window
;;; *
;;; *
;;; * 26/01/2008 Version 0002. Edition Vladimir Azarko (VVA)
;;; - the Output on double a clique if the plural choice (multi-nil) is forbidden
;;; - Processing of several columns
;;; * 21/01/2008 Version 0001. Edition Vladimir Azarko (VVA)
(defun _DWGRU-GET-USER-DCL (ZAGL        INFO-LIST   MULTI
                            /           FL          RET
                            DCL_ID      MAXROW      MAX_COUNT_COL
                            COUNT_COL   I           LISTBOX_HEIGHT
                            LST         _LOC_FINISH _LOC_CLEAR
                            NCOL
                           )
;|
* Inquiry of value at the user through a dialogue window
* Dialogue is formed to "strike"
* the Quantity of lines on page without scrolling is set by variable MAXROW.
* It is necessary to remember, that number MAXROW increases on 3.
* the Maximum quantity of columns is set by variable MAX_COUNT_COL
* It is published
     http://dwg.ru/f/showthread.php?p=203746#post203746
* Parameters of a call:
    zagl - heading of a window [String]
    info-list - the list of line values[List of String]
    multi - t - the plural choice is resolved, nil-is not present
     
* Returns:
 The list of the chosen lines or nil - a cancelling
* the Example
 (_dwgru-get-user-dcl " Specify a variant " ' ("First" "Second" "Third") nil); _-> ("First")
 (_dwgru-get-user-dcl " Specify a variant " ' ("First" "Second" "Third") t); _-> ("First"  "Second ")
 (_dwgru-get-user-dcl " Specify a variant "
   (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Value-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) nil)
 (_dwgru-get-user-dcl " Specify a variant, using CTRL and SHIFT for a choice "
   (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Value-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) t)
|;
  (setq MAXROW 40) ;_  max lines without scrolling (To it 3 more lines further will be added)
  (setq MAX_COUNT_COL 5) ; _ a maximum quantity of columns
;;============== Local functions START========================

  (defun _LOC_FINISH ()
    (setq I   0
          RET NIL
    ) ;_ end ofsetq
    (repeat COUNT_COL
      (setq I (1+ I))
      (setq RET (cons (cons I (get_tile (strcat "info" (itoa I)))) RET))
    ) ;_ end ofrepeat
    (setq RET (reverse RET))
    (done_dialog 1)
  ) ;_ end ofdefun
  (defun _LOC_CLEAR (NOMER)
    (setq I 0)
    (repeat COUNT_COL
      (setq I (1+ I))
      (if (/= I NOMER)
        (progn
          (start_list (strcat "info" (itoa I)))
          (mapcar 'add_list (nth (1- I) LST))
          (end_list)
        ) ;_ end ofprogn
      ) ;_ end ofif
    ) ;_ end ofrepeat
  ) ;_ end ofdefun

;;;==================== Local functions END ==================================
;;;==================== MAIN PART ===============================================
  (if (null ZAGL)(setq ZAGL "Select")) ;_ end if
  (if (zerop (rem (length INFO-LIST) MAXROW))
    (setq COUNT_COL (/ (length INFO-LIST) MAXROW))
    (setq COUNT_COL (1+ (fix (/ (length INFO-LIST) MAXROW 1.0))))
  ) ;_ end ofif
  (if (> COUNT_COL MAX_COUNT_COL)
    (setq COUNT_COL MAX_COUNT_COL)
  )
  (setq LISTBOX_HEIGHT (+ 3 MAXROW))
   ;_ We add 3 lines for appearance and for exception boundary scroll
  (if (and (= COUNT_COL 1) (<= (length INFO-LIST) MAXROW))
    (setq LISTBOX_HEIGHT (+ 3 (length INFO-LIST)))
  ) ;_ end ofif
  (setq I 0)
  (setq FL (vl-filename-mktemp "dwgru" NIL ".dcl"))
  (setq RET (open FL "w")
        LST NIL
  ) ;_ end ofsetq
  (mapcar '(lambda (X) (write-line X RET))
          (append (list "dwgru_get_user : dialog { "
                        (strcat "label=\"" ZAGL "\";")
                        ": boxed_row {"
                        "label = \"Value\";"
                  ) ;_ end oflist
                  (repeat COUNT_COL
                    (setq LST
                           (append
                             LST
                             (list
                               " :list_box {"
                               "alignment=top ;"
                               (if MULTI
                                 "multiple_select = true ;"
                                 "multiple_select = false ;"
                               ) ;_ end ofif
                               "width=31 ;"
                               (strcat "height= " (itoa LISTBOX_HEIGHT) " ;")
                               "is_tab_stop = false ;"
                               (strcat "key = \"info" (itoa (setq I (1+ I))) "\";}")
                             ) ;_ end oflist
                           ) ;_ end ofappend
                    ) ;_ end ofsetq
                  ) ;_ end ofrepeat
                  (list
                    "}"
                    ":row{"
                    "ok_cancel_err;}}"
                  ) ;_ end oflist
          ) ;_ end of list
  ) ;_ end of mapcar
  (setq RET (close RET))
  (if (and (null (minusp (setq DCL_ID (load_dialog FL))))
           (new_dialog "dwgru_get_user" DCL_ID)
      ) ;_ end and
    (progn
      (setq LST INFO-LIST)
      ((lambda (/ RET1 BUF ITM)

         (repeat (1- COUNT_COL)
           (setq I '-1)
           (while (and (setq ITM (car LST))
                       (< (setq I (1+ I)) MAXROW)
                  ) ;_ end of and
             (setq BUF (cons ITM BUF)
                   LST (cdr LST)
             ) ;_ end of setq
           ) ;_ end ofwhile
           (setq RET1 (cons (reverse BUF) RET1)
                 BUF  NIL
           ) ;_ end of setq
         ) ;_ end of repeat
         (setq RET RET1)
       ) ;_ end of lambda
      )
      (if LST
        (setq RET (cons LST RET))
      ) ;_ end ofif
      (setq LST (reverse RET))
      (setq I 0)
      (mapcar '(lambda (THIS_LIST)
                 (if (<= (setq I (1+ I)) COUNT_COL)
                   (progn
                     (start_list (strcat "info" (itoa I)))
                     (mapcar 'add_list THIS_LIST)
                     (end_list)
                   ) ;_ end ofprogn
                 ) ;_ end ofif
               ) ;_ end oflambda
              LST
      ) ;_ end ofmapcar

      (set_tile "info1" "0")
      (setq I 0
            NCOL 1
      ) ;_ end ofsetq
      (repeat COUNT_COL
        (action_tile
          (strcat "info" (itoa (setq I (1+ I))))
          (strcat "(progn (setq Ncol "
                  (itoa I)
                  ")(if (not multi)(_loc_clear Ncol))"
                  "(if (and (not multi)(= $reason 4))(_loc_finish)))"
          ) ;_ end ofstrcat
        ) ;_ end ofaction_tile
      ) ;_ end ofrepeat
      (action_tile "cancel" "(done_dialog 0)")
      (action_tile "accept" "(_loc_finish)")
      (if MULTI
        (set_tile "error" "Use CTRL and SHIFT for a choicet") ;_ end ofset_tile
        (set_tile "error" "It is possible to choose double click") ;_ end ofset_tile
      ) ;_ end ofif
      (if (zerop (start_dialog))
        (setq RET NIL)
        (progn
          (setq
            RET (apply
                  'append
                  (mapcar
                    '(lambda (ITM)
                       (setq THIS_LIST (nth (1- (car ITM)) LST))
                       (mapcar
                         (function (lambda (NUM) (nth NUM THIS_LIST)))
                         (read (strcat "(" (cdr ITM) ")"))
                       ) ;_ end ofmapcar
                     ) ;_ end oflambda
                    RET
                  ) ;_ end ofmapcar
                ) ;_ end ofapply
          ) ;_ end ofsetq

        ) ;_ end ofprogn
      ) ;_ end if
      (unload_dialog DCL_ID)
    ) ;_ end of progn
  ) ;_ end of if
  (vl-file-delete FL)
  RET
) ;_ end ofdefun
Othe ColorX... command
Quote
Command:
ColorX - change color all object of drawing. All layer unlock and thaw
ColorXREF - change color xref only on a current session. All layer unlock and thaw
ColorXL - change color all object of drawing. Objects on the locked and frozen layers are ignored
ColorXREFL - change color xref only on a current session. Objects on the locked and frozen layers are ignored

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: color change xref (select)
« Reply #4 on: June 04, 2018, 06:14:07 PM »
In AutoCAD 2019, all of the versions (mine included) seems to change the color of ALL objects, not just the select xref(s), any ideas?
« Last Edit: June 04, 2018, 06:17:58 PM by cmwade77 »

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: color change xref (select)
« Reply #5 on: June 06, 2018, 02:27:31 PM »
I figured out where some of the problems were, here is my new updated version that does plotstyles and colors as well as nested xRefs. I have also changed to use default settings that are set at the beginning of the routine and added the ability to select multiple xRefs at once.

Code: [Select]
;Code Modified from T. Willey's Code at: http://www.theswamp.org/index.php?topic=35168.msg403946#msg403946
;Modified by Chris Wade - 06/06/2018 to allow for
;Selecting multiple xrefs
;Handling NestedxRefs
;Using default settings
;Setting plotstyle as well as color

(defun c:xrc (/ ActDoc Sel Clr Data XrName Pstyle Nested NestedList xName ct sCt xRefs)
    (setq clr 8 ;Sets the color
          Pstyle "Shaded" ;Sets PlotStyle if applicable
          Nested T ;If nil nested xrefs will not be processed
    )

    ; The code below has been adapted from:
    ; T. Willey's Code at http://www.theswamp.org/index.php?topic=34277.0
(defun nxr ( xr / GetXrefNesting PrintNestedList MyList xRefs)
    ; Prints nested xref tree to command line, no matter how deep the nesting.
    (defun GetXrefNesting (/ GetXrefInfo tempData tempEnt XrefList NonNestedXrefList NestedXrefList )       
        (defun GetXrefInfo ( ent / NestList )
            (foreach i (member '(102 . "{BLKREFS") (entget ent))
                (if (equal (car i) 332)
                    (progn
                        (setq NestedList (cons (cdr i) NestedList))
                        (setq NestList
                            (cons
                                (cons
                                    (cdr i)
                                    (GetXrefInfo (cdr i))
                                )
                                NestList
                            )
                        )
                    )
                )
            )
            NestList
        )
        ;-------------------------------------       
        (while (setq tempData (tblnext "block" (not tempData)))
            (if (equal (logand (cdr (assoc 70 tempData)) 4) 4)
                (progn
                    (setq tempEnt (tblobjname "block" (cdr (assoc 2 tempData))))
                    (setq tempEnt (cdr (assoc 330 (entget tempEnt))))
                    (setq XrefList
                        (cons
                            (cons
                                tempEnt
                                (GetXrefInfo tempEnt)
                            )
                            XrefList
                        )
                    )
                )
            )
        )
        (foreach i XrefList
            (if (not (member (car i) NestedList))
                (setq NonNestedXrefList (cons i NonNestedXrefList))
            )
        )
        NonNestedXrefList
    )
    ;------------------------------------------------
    (defun PrintNestedList ( lst spc )
        (foreach
            i
            (vl-sort
                lst
                (function
                    (lambda ( a b )
                        (<
                            (strcase (cdr (assoc 2 (entget (car a)))))
                            (strcase (cdr (assoc 2 (entget (car b)))))
                        )
                    )
                )
            )
         (setq NX (cdr (assoc 2 (entget (car i)))))
         (if (= MyList nil)           
               (setq MyList (list NX))
               (setq MyList (append MyList (list NX)))
         )
            ;(prompt (strcat "\n" spc " Nested xref: " (cdr (assoc 2 (entget (car i))))))
            (PrintNestedList (cdr i) (strcat "  " spc))
         
            ;(PrintNestedList (cdr i) (strcat "  |" spc)) ; second option shown below
        )
    )
    ;-----------------------------------------------------       
   (foreach
        i
        (vl-sort
            (GetXrefNesting)
            (function
                (lambda ( a b )
                    (<
                        (strcase (cdr (assoc 2 (entget (car a)))))
                        (strcase (cdr (assoc 2 (entget (car b)))))
                    )
                )
            )
        )
      (if (= xr (cdr (assoc 2 (entget (car i)))))
         (progn
            ;(prompt (strcat "\n Main xref: " (cdr (assoc 2 (entget (car i))))))
            (PrintNestedList (cdr i) "  |-")
         )
      )
    )
    MyList
)

(defun ChangeNow (XrName Clr PStyle / i ActDoc)
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vlax-for i (vla-get-Layers ActDoc)
        (if (wcmatch (vla-get-Name i) XrName)
            (progn
                (vla-put-Color i Clr)
                (if (and (= (getvar "pstylemode") 0) (/= pstyle nil))
                    (vla-put-plotstylename i pstyle)
                )
            )
        )
    )
)

    ; Change all the layers of an xref to selected color.
   
    (vl-load-com)
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (while (= xRefs nil)
        (princ "\rSelect xRefs to change: ")
        (setq xRefs (ssget (list (cons 0 "INSERT"))))
    )
   
        (setq sCt 0)
    (while (< sCt (sslength xRefs))
            (setq Sel (ssname xRefs sCt)
                  sCt (+ sCt 1)
                  Data (entget Sel)
            )
            (if (= (cdr (assoc 0 Data)) "INSERT")
                (setq xName (cdr (assoc 2 Data)))
            )
           
            (setq XrName
                    (if
                        (and
                            (setq Data (entget Sel))
                            (= (cdr (assoc 0 Data)) "INSERT")
                            (setq XrName (cdr (assoc 2 Data)))
                            (equal (logand (cdr (assoc 70 (tblsearch "block" XrName))) 4) 4)
                        )
                        (setq XrName (strcat xName "|*"))
                    )
            )
            (if (and (/= xName nil) (/= XrName nil))
                (progn
                    (if (and (/= xName "") (/= xRname ""))
                        (progn
                            (ChangeNow XrName Clr PStyle)
                            (if Nested
                                (Progn
                                    (setq NestedList (nxr xName))
                                    (if (/= NestedList nil)
                                        (progn
                                            (setq ct 0)
                                            (while (< ct (length MyList))
                                                (setq xName (strcat (nth ct NestedList))
                                                      XrName (strcat xName "|*")
                                                )
                                                (ChangeNow XrName Clr PStyle)
                                                (setq ct (+ ct 1))
                                            )
                                        )
                                    )
                                )
                            )
                        )
                    )
                )
            )
    )
            (vla-Regen ActDoc acActiveViewport)
   
    (vla-EndUndoMark ActDoc)
    (princ)
)
« Last Edit: June 06, 2018, 02:54:03 PM by cmwade77 »

HasanCAD

  • Swamp Rat
  • Posts: 1420
Re: color change xref (select)
« Reply #6 on: June 13, 2018, 07:41:51 AM »
This lisp Works related to layer name
Code - Auto/Visual Lisp: [Select]
  1. ;;     q_|_|| _\|| q_|| _\|     ;;
  2. ;;       Mainroutine Start      ;;
  3. ; HasanCAD - 2018 06 13
  4.  
  5. (defun c:XCL () (c:XrefCelingLayersprepare))
  6. (defun c:XrefCelingLayersprepare ( / all_layers all_layers-l cap-total cap-total_l cap-xl cap-xl-s
  7.                                   doc dsc ent xl xl-as_l xl-as_l-name xl-as_l-names xl-as_l-names_l
  8.                                   xl-chngd xl-off_l xl-off_l-name xl-off_l-names xl-off_l-names_l
  9.                                   xl-on_l xl-on_l-name xl-on_l-names xl-on_l-names_l xl-s xl-s-chngd )
  10.  
  11.   (vl-cmdf "_.-layer" "ON" "0" "")
  12.   (vl-cmdf "_.-layer" "Thaw" "0" "")
  13.   (vl-cmdf "_.-layer" "OFF" "Defpoints" "")
  14.   (setvar 'CLAYER "0")
  15.    
  16. (setq XL_ON (list
  17.               "*|A-ANNO-AREA-NAME"
  18.               "*|A-ANNO-AREA-NAME-ENG"
  19.               "*|A-ANNO-GRD-TAG"
  20.             )
  21. )
  22. (setq XL_AS (list
  23.               "*|A-ANNO-CLNG"
  24.               "*|A-CLNG"
  25.               "*|A-CLNG-ACCS"
  26.               "*|A-CLNG-ELEC"
  27.  
  28.             )
  29. )
  30. (setq XL_OFF (list
  31.                "*|A-ANNO-AREA-FINIH"
  32.                "*|A-ANNO-CRTN"
  33.                "*|A-ANNO-DIM"
  34.                "*|A-ANNO-DOOR"
  35.              )
  36. )
  37.  (XL-ON-OFF XL_AS XL_ON XL_OFF 252 acLnWt009)   ;acLnWt009 = 0.09
  38.  
  39.   (princ)
  40.   )
  41.  
  42. ;;     q_|_|| _\|| q_|| _\|     ;;
  43. ;;       Mainroutine End        ;;
  44.  
  45.  
  46. ;;     q_|_|| _\|| q_|| _\|     ;;
  47. ;;       Subroutine Start       ;;
  48.  
  49. (Defun XL-ON-OFF (XL-AS XL-ON XL-OFF XL-Clr XL-LW / )
  50.  
  51.   (setq All_Layers NIL)
  52.   (setq CAP-Total NIL)
  53.   (if (while (setq XL (tblnext "LAYER" (null XL)))
  54.         (setq All_Layers (cons (cdr (assoc 2 XL)) All_Layers))
  55.       )
  56.     (foreach n All_Layers
  57.       (setq ent (vlax-ename->vla-object (tblobjname "LAYER" n)))
  58.       (setq dsc (vlax-get-property ent 'Description))
  59.       (if (eq "CAP:" (substr dsc 1 4))
  60.         (setq CAP-Total (cons n CAP-Total))
  61.       )
  62.     )
  63.   )
  64.  (setq All_Layers-L (vl-list-length All_Layers))
  65.  (setq CAP-Total_L (vl-list-length CAP-Total))
  66.  
  67.  
  68.  (setq XL-AS_L-NameS NIL)
  69.    (repeat (setq XL-AS_L (vl-list-length XL-AS))
  70.      (if (wcmatch (setq XL-AS_L-Name (vla-get-Name i))
  71.                   (nth (setq XL-AS_L (1- XL-AS_L)) XL-AS)
  72.          )
  73.        (progn (vla-put-LayerOn i :vlax-True)
  74.               (vla-put-freeze i :vlax-false)
  75.               (setq XL-AS_L-NameS (cons XL-AS_L-Name XL-AS_L-NameS))
  76.        )
  77.      )
  78.    )
  79.  )
  80.  (setq XL-AS_L-NameS_L (vl-list-length XL-AS_L-NameS))
  81.  
  82.  (setq XL-ON_L-NameS NIL)
  83.    (repeat (setq XL-ON_L (vl-list-length XL-ON))
  84.      (if (wcmatch (setq XL-ON_L-Name (vla-get-Name i))
  85.                   (nth (setq XL-ON_L (1- XL-ON_L)) XL-ON)
  86.          )
  87.        (progn (vla-put-LayerOn i :vlax-True)
  88.               (vla-put-freeze i :vlax-false)
  89.               (vla-put-Color i XL-Clr)
  90.               (vla-put-lineweight i XL-LW)
  91.               (setq XL-ON_L-NameS (cons XL-ON_L-Name XL-ON_L-NameS))
  92.        )
  93.      )
  94.    )
  95.  )
  96.  (setq XL-ON_L-NameS_L (vl-list-length XL-ON_L-NameS))
  97.  
  98.  (setq XL-OFF_L-NameS NIL)
  99.    (repeat (setq XL-OFF_L (vl-list-length XL-OFF))
  100.      (if (wcmatch (setq XL-OFF_L-Name (vla-get-Name i))
  101.                   (nth (setq XL-OFF_L (1- XL-OFF_L)) XL-OFF)
  102.          )
  103.        (progn (vla-put-freeze i :vlax-True)
  104.               (setq XL-OFF_L-NameS (cons XL-OFF_L-Name XL-OFF_L-NameS))
  105.        )
  106.      )
  107.    )
  108.  )
  109.  (setq XL-OFF_L-NameS_L (vl-list-length XL-OFF_L-NameS))
  110.  
  111.  (setq XL-Chngd (+ XL-AS_L-NameS_L XL-ON_L-NameS_L XL-OFF_L-NameS_L))
  112.  (setq XL (- All_Layers-L XL-Chngd))
  113.  (setq CAP-XL (- All_Layers-L CAP-Total_L))
  114.  
  115.   (cond
  116.     ((< 1 XL-Chngd) (setq XL-S-Chngd (strcat "\n " (itoa XL-Chngd) " Layers has been Changed")))
  117.     ((= 1 XL-Chngd) (setq XL-S-Chngd (strcat "\n " (itoa XL-Chngd) " Layer has been Changed")))
  118.     ((> 1 XL-Chngd) (setq XL-S-Chngd (strcat "\nAll layers has been changed")))
  119.     )
  120.   (cond
  121.     ((< 1 XL) (setq XL-S (strcat "\n " (itoa XL) " Layers Not Changed Due to layer name")))
  122.     ((= 1 XL) (setq XL-S (strcat "\n " (itoa XL) " Layer Not Changed Due to layer name")))
  123.     ((> 1 XL) (setq XL-S (strcat "\nAll layers has been changed")))
  124.     )
  125.   (cond
  126.     ((< 1 CAP-XL) (setq CAP-XL-S (strcat "\n " (itoa CAP-XL) " Layers in Xrefs Out of CAP Standards")))
  127.     ((= 1 CAP-XL) (setq CAP-XL-S (strcat "\n " (itoa CAP-XL) " Layer in Xrefs Out of CAP Standards" )))
  128.     ((> 1 CAP-XL) (setq CAP-XL-S "\nNo Xref Layers Out of CAP Standards"))
  129.     )
  130.  
  131.   (vla-Regen doc acActiveViewport)
  132.   (Alert (strcat (itoa All_Layers-L)
  133.                  " Layers in the file"
  134.                  "\n"
  135.                  XL-S-Chngd
  136.                  "\n"
  137.                  XL-S
  138.                  "\n"
  139.                  CAP-XL-S
  140.          )
  141.   )
  142.   )
  143.  
  144.   (defun *error* (msg)
  145.     (vla-endundomark doc)
  146.     (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  147.       (princ (strcat "\nError: " msg))
  148.     )
  149.     (setvar "visretain" 1)
  150.     (princ)
  151.   )
  152.  
  153. ;;     q_|_|| _\|| q_|| _\|     ;;
  154. ;;        Subroutine End        ;;

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: color change xref (select)
« Reply #7 on: June 13, 2018, 11:31:02 AM »
Very nice code, not really my use case, but I can definitely see where it would be handy.