Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Reply
Active Contributor
b-man
Posts: 32
Registered: ‎11-08-2008
Message 1 of 7 (344 Views)

Change Color and Linetype of an x-ref Nested Entity

344 Views, 6 Replies
08-22-2012 02:45 PM

I have a Lisp that I have been working on with some folks in the office, and i feel like i am close, but i am not getting the cigar. The idea would be to have the lisp allow the user to select a nested x-ref entity, and change the color and linetype of the selected layer, similar to the old "LAP" command (I know it is a dinosaur, but I still miss it). I seem to be doing swimmingly, thanks to code I have quasi-plagiarized. It seems to crap out where i try to pass the selected linetype back to the layer. I get the nastygram "Command: ; error: no function definition: GETLINETYPE" right after selecting the linetype from the dialog.

 

Any help (and explanation) would be greatly appreciated.

 

Code below...

 

x(defun c:CX (/ Sel EntList DataList cnt Num ClrNum EntData)

(if (setq Sel (nentsel "\n Select object to change layers color and linetype: "))
(progn
(if (> (length Sel) 2)
(setq EntList (cons (car Sel) (last Sel)))
(setq EntList (cons (car Sel) EntList))
)
(setq DataList
(mapcar
'(lambda (x / EntData)
(setq EntData (entget x))
(cons (cdr (assoc 0 EntData)) (cdr (assoc 8 EntData)))
)
EntList
)
)
(setq cnt 0)
(textscr)
(prompt "\n Select number of layer to change color: ")
(foreach lst DataList
(prompt (strcat "\n " (itoa cnt) " - " (cdr lst) " - Object [ " (car lst) " ]"))
(setq cnt (1+ cnt))
)
(while
(and
(not (setq Num (getint (strcat "\n Select number between 0 - " (itoa (1- cnt)) ": "))))
(not (< 0 Num (1- cnt)))
)
)
(graphscr)
(if (and Num (setq ClrNum (acad_colordlg 0)))
(progn
(setq EntData (entget (tblobjname "Layer" (cdr (nth Num DataList)))))
(entmod
(subst
(cons 62 ClrNum)
(assoc 62 EntData)
EntData
)
)
)
; (graphscr)
(vl-load-com)
(if (and Num (setq lt (vla-get-linetype (tblobjname "Layer" (cdr (nth Num DataList)))))))
(progn
(setq EntData1 (entget (tblobjname "Layer" (cdr (nth Num DataList)))))
(setq CL (getvar "CELTYPE"))
(initdia)
(command "_.LINETYPE")
(while (= (logand (getvar "CMDACTIVE") 8) 1) (command pause))
(if (/= (getvar "celtype") CL)
(setq SL (getvar "celtype"))
(setq SL CL)
)
(setvar "celtype" CL)
SL
)
;
(setq LTYPE1 (sl))
(entmod
(subst
(cons 8 lt)
(assoc 8 LTYPE1)
EntData1
)
)
)
(command "_.Regen")
)
)
(princ)
)

 

Andrew Martin
ESP Associates
HP Elitebook Workstation
Windows 7

"The only thing worse than training your employees and having them leave is not training them and having them stay" - Henry Ford (a fairly successful businessman)
*Expert Elite*
Kent1Cooper
Posts: 5,539
Registered: ‎09-13-2004
Message 2 of 7 (311 Views)

Re: Change Color and Linetype of an x-ref Nested Entity

08-24-2012 02:40 PM in reply to: b-man

b-man wrote:

.... The idea would be to have the lisp allow the user to select a nested x-ref entity, and change the color and linetype of the selected layer....


Quickly [on my way out the door] -- could it be as simple as this?  For one entity:

 

(setq lay (cdr (assoc 8 (entget (car (nentsel "\n Select object to change layers color and linetype: "))))))

...

whatever method you choose to get the User to designate YourColor and YourLinetype

...

(command "_.layer" "_color" "YourColor" lay "_ltype" "YourLinetype" lay "")

 

If more than one nested entity is selected, have it put their Layer names into a comma-delimited string instead of into a list, put that into a variable in place of the 'lay' variable in the (command) function, and the Layer command will change those properties of all of those Layers at once.

Kent Cooper
Active Contributor
b-man
Posts: 32
Registered: ‎11-08-2008
Message 3 of 7 (306 Views)

Re: Change Color and Linetype of an x-ref Nested Entity

08-24-2012 02:53 PM in reply to: Kent1Cooper

You are right, in that it is that easy. My challenge is in passing the selected linetype (selected in the portion of the code that pulls up the linetype dialog)

 

 

(vl-load-com)
(if (and Num (setq lt (vla-get-linetype (tblobjname "Layer" (cdr (nth Num DataList)))))))
(progn
(setq EntData1 (entget (tblobjname "Layer" (cdr (nth Num DataList)))))
(setq CL (getvar "CELTYPE"))
(initdia)
(command "_.LINETYPE")
(while (= (logand (getvar "CMDACTIVE") 8) 1) (command pause))
(if (/= (getvar "celtype") CL)
(setq SL (getvar "celtype"))
(setq SL CL)
)
(setvar "celtype" CL)
SL
)
;
(setq LTYPE1 (sl))
(entmod
(subst
(cons 8 lt)
(assoc 8 LTYPE1)
EntData1

 

to the layer command. Maybe I am misunderstanding  your suggestion, though.

Andrew Martin
ESP Associates
HP Elitebook Workstation
Windows 7

"The only thing worse than training your employees and having them leave is not training them and having them stay" - Henry Ford (a fairly successful businessman)
*Expert Elite*
Kent1Cooper
Posts: 5,539
Registered: ‎09-13-2004
Message 4 of 7 (297 Views)

Re: Change Color and Linetype of an x-ref Nested Entity

08-24-2012 07:21 PM in reply to: b-man

b-man wrote:

....

(initdia)
(command "_.LINETYPE")
(while (= (logand (getvar "CMDACTIVE") 8) 1) (command pause))
....


I notice one thing....  I believe the test in the (while) function will never be satisfied.  As I understnad (logand), I don't think (logand {anything} 8) can ever equal 1.  So I think it's not ever going to pause.  I believe you want to check whether it equals 8, rather than 1.

Kent Cooper
*Expert Elite*
Kent1Cooper
Posts: 5,539
Registered: ‎09-13-2004
Message 5 of 7 (271 Views)

Re: Change Color and Linetype of an x-ref Nested Entity

08-27-2012 08:41 AM in reply to: b-man

I looked at it a little more closely [I haven't ferreted out exactly what everything is doing], and added indentation and identifying notes to make it easier to read what's happening, and I have some comments/questions:

 

(if (setq Sel (nentsel "\n Select object to change layers color and linetype: "))
  (progn; then
    (if (> (length Sel) 2)
      (setq EntList (cons (car Sel) (last Sel)))
      (setq EntList (cons (car Sel) EntList))
    ); end if
    (setq DataList
      (mapcar
        '(lambda (x / EntData)
          (setq EntData (entget x))
          (cons (cdr (assoc 0 EntData)) (cdr (assoc 8 EntData)))
        ); lambda
        EntList
      ); end mapcar
    ); end setq
    (setq cnt 0)
    (textscr)
    (prompt "\n Select number of layer to change color: ")
    (foreach lst DataList
      (prompt (strcat "\n " (itoa cnt) " - " (cdr lst) " - Object [ " (car lst) " ]"))
      (setq cnt (1+ cnt))
    ); end foreach
    (while
      (and
        (not (setq Num (getint (strcat "\n Select number between 0 - " (itoa (1- cnt)) ": "))))
        (not (< 0 Num (1- cnt)))
      ); end and
    ); end while
    (graphscr)
    (if (and Num (setq ClrNum (acad_colordlg 0)))
      (progn
        (setq EntData (entget (tblobjname "Layer" (cdr (nth Num DataList)))))
        (entmod
          (subst
            (cons 62 ClrNum)
            (assoc 62 EntData)
            EntData
          ); end subst
        ); end entmod
      ); end progn
;;;;; MISSING   ); end if   somewhere in here?
; (graphscr)
    (vl-load-com); this can't be meant for an 'else' argument, but that's where it
;;;;; falls if the (if) function above isn't closed.
    (if (and Num (setq lt (vla-get-linetype (tblobjname "Layer" (cdr (nth Num DataList)))))))
      (progn ; then
        (setq EntData1 (entget (tblobjname "Layer" (cdr (nth Num DataList)))))

          ;;;;; Any reason not to just re-use the EntData variable from the color portion?

          ;;;;; Would need to set it again here, and wouldn't need the additional variable name.
        (setq CL (getvar "CELTYPE"))
        (initdia)
        (command "_.LINETYPE")
        (while (= (logand (getvar "CMDACTIVE") 8) 1) (command pause))
          ;;;;; Despite my earlier reply, I find in some experimenting that the
          ;;;;;   above is actually expendable [the dialog box takes care of it].
        (if (/= (getvar "celtype") CL); if User chose linetype other than what WAS current,
          (setq SL (getvar "celtype")); then -- set that into SL
          (setq SL CL); else -- set what WAS current into SL
            ;;;;; Could simply do the 'then' line without the (if) wrapper --
            ;;;;;   The Linetype command/dialog box will set CELTYPE, and whether or
            ;;;;;   not it's different from what was current before, that's what you want in SL
        ); end if
        (setvar "celtype" CL); else
          ;;;;; Isn't that the same as doing nothing?  User didn't pick a different linetype,
          ;;;;; so there's nothing to do, so omit the 'else' argument.
        SL
      ); end progn
        ;;;;; do you really want to end 'then' there, or continue with the rest INSIDE the 'then' argument?
;;;;; MISSING   ); end if   somewhere in here? or:
      (setq LTYPE1 (sl)) ;;;;; is this supposed to be an 'else' argument?
        ;;;;; No (sl) function defined --
        ;;;;; Should the above be (setq LTYPE1 SL)?
        ;;;;; Is there any need for LTYPE1 variable separate from SL?
      (entmod
        (subst
          (cons 8 lt)
            ;;;;; But lt is already its linetype --
            ;;;;; Should this be (cons 8 SL) to make the NEW linetype a Layer assignment?
            ;;;;; Or if there's a need for different SL and LTYPE1 variables, (cons 8 LTYPE1)?
            ;;;;; Or since the Linetype command will have set CELTYPE and that goes into
            ;;;;;   both SL and LTYPE1, could this just be (cons 8 (getvar 'celtype)), and can
            ;;;;;   you skip the CL and SL and LTYPE1 variables entirely?
          (assoc 8 LTYPE1)
            ;;;;; But LTYPE1 would need to be an entity data list -- should this be (assoc 8 EntData1)?
          EntData1
        ); end subst
      ); end entmod
    ); end if
    (command "_.Regen")
  ); end progn
); end if
(princ)
);;;;; is this the end defun from code prior to the top of the posted code?

Kent Cooper
*Expert Elite*
Kent1Cooper
Posts: 5,539
Registered: ‎09-13-2004
Message 6 of 7 (263 Views)

Re: Change Color and Linetype of an x-ref Nested Entity

08-27-2012 09:51 AM in reply to: Kent1Cooper

Flubbed a couple of things up -- this part:

 

        (setvar "celtype" CL); else
          ;;;;; Isn't that the same as doing nothing?  User didn't pick a different linetype,
          ;;;;; so there's nothing to do, so omit the 'else' argument.
        SL

 

should be more like this:

 

        (setvar "celtype" CL) ;;;;; [that's OK -- I misunderstood in two diffeent ways before....]
        SL ;;;;; don't know what this is here for

 

and this part should be omitted:

 

            ;;;;; Or since the Linetype command will have set CELTYPE and that goes into
            ;;;;;   both SL and LTYPE1, could this just be (cons 8 (getvar 'celtype)), and can
            ;;;;;   you skip the CL and SL and LTYPE1 variables entirely?

Kent Cooper
*Expert Elite*
Kent1Cooper
Posts: 5,539
Registered: ‎09-13-2004
Message 7 of 7 (255 Views)

Re: Change Color and Linetype of an x-ref Nested Entity

08-27-2012 10:27 AM in reply to: b-man

Looked yet a little deeper, and found a few other things.....  This seems to work, in limited testing [wipe out my comments, etc., if it works for you, too], though I think it could be simplified further:

 

(if (setq Sel (nentsel "\n Select object to change layers color and linetype: "))
  (progn ; then
    (if (> (length Sel) 2)
      (setq EntList (cons (car Sel) (last Sel)))
      (setq EntList (cons (car Sel) EntList))
    ); end if
    (setq DataList
      (mapcar
        '(lambda (x / EntData)
          (setq EntData (entget x))
          (cons (cdr (assoc 0 EntData)) (cdr (assoc 8 EntData)))
        ); lambda
        EntList
      ); end mapcar
    ); end setq
    (setq cnt 0)
    (textscr)
    (prompt "\n Select number of layer to change color: ")
    (foreach lst DataList
      (prompt (strcat "\n " (itoa cnt) " - " (cdr lst) " - Object [ " (car lst) " ]"))
      (setq cnt (1+ cnt))
    ); end foreach
    (while
      (and
        (not (setq Num (getint (strcat "\n Select number between 0 - " (itoa (1- cnt)) ": "))))
        (not (< 0 Num (1- cnt)))
      ); end and
    ); end while
    (graphscr)
    (if (and Num (setq ClrNum (acad_colordlg 0)))
      (progn
        (setq EntData (entget (tblobjname "Layer" (cdr (nth Num DataList)))))
        (entmod
          (subst
            (cons 62 ClrNum)
            (assoc 62 EntData)
            EntData
          ); end subst
        ); end entmod
      ); end progn
;;;;; MISSING   ); end if   somewhere in here?
    ); end if ;;;;; I added this
; (graphscr)
    (vl-load-com); this can't be meant for an 'else' argument, but that's where it
;;;;; falls if the (if) function above isn't closed
;;;;;    (if (and Num (setq lt (vla-get-linetype (tblobjname "Layer" (cdr (nth Num DataList))))))); not a vla object!
    (if (and Num (setq lt (cdr (assoc 6 (entget (tblobjname "Layer" (cdr (nth Num DataList))))))))

      ;;;;; could do (vlax-ename->vla-object conversion instead of (cdr (assoc 6....
      (progn ; then
        (setq EntData1 (entget (tblobjname "Layer" (cdr (nth Num DataList)))))
          ;;;;; Any reason not to just re-use the EntData variable from the color portion?
          ;;;;; Would need to set it again here, and wouldn't need the additional variable name.
        (setq CL (getvar "CELTYPE"))
        (initdia)
        (command "_.LINETYPE")
;;;;;        (while (= (logand (getvar "CMDACTIVE") 8) 1) (command pause)) ;;;;; I commented out
          ;;;;; Despite my earlier reply, I find in some experimenting that the
          ;;;;;   above is actually expendable [the dialog box takes care of it].
        (if (/= (getvar "celtype") CL); if User chose linetype other than what WAS current,
          (setq SL (getvar "celtype")); then -- set that into SL
          (setq SL CL); else -- set what WAS current into SL
            ;;;;; Could simply do the 'then' line without the (if) wrapper --
            ;;;;;   The Linetype command/dialog box will set CELTYPE, and whether or
            ;;;;;   not it's different from what was current before, that's what you want in SL
        ); end if
        (setvar "celtype" CL)
;;;;;        SL ;;;;; Don't know what this is here for -- I commented out
;;;;;      ); end progn ;;;;; I commented out -- moved below
        ;;;;; do you really want to end 'then' there, or continue with the rest INSIDE the 'then' argument?
;;;;; MISSING   ); end if   somewhere in here? or:
;;;;;        (setq LTYPE1 (sl)) ;;;;; is this supposed to be an 'else' argument? I commented out
          ;;;;; No (sl) function defined --
          ;;;;; Should the above be (setq LTYPE1 SL)?
          ;;;;; Is there any need for LTYPE1 variable separate from SL?
;;;;;        (setq LTYPE1 SL) ;;;;; I substituted, but commented out
        (entmod
          (subst
;;;;;            (cons 8 lt) ;;;;; should be 6, not 8
              ;;;;; But lt is already its linetype --
              ;;;;; Should this be (cons 8 SL) to make the NEW linetype a Layer assignment?
              ;;;;; Or if there's a need for different SL and LTYPE1 variables, (cons 8 LTYPE1)?
            (cons 6 SL) ;;;;; I substituted
;;;;;            (assoc 8 LTYPE1) ;;;;; should be 6, not 8
              ;;;;; But LTYPE1 would need to be an entity data list -- should this be (assoc 8 EntData1)?
            (assoc 6 EntData1) ;;;;; I substituted
            EntData1
          ); end subst
        ); end entmod
      ); end progn/then ;;;;; I moved this here from commented-out location above
    ); end if -- selected something
    (command "_.Regen")
  ); end progn
); end if

 

Kent Cooper
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.