Nentsel Highlight

[Anonymous]

Hi everyone.

I am writing a 'visual script generator'. Quite often, on a set of drawings, the first drawing will come back marked up with certain layers in xrefs to be frozen, with a 'freeze on every sheet' note. Writing a script is easy enough, but sometimes we have to trawl through he layer dialog box to find the right layer to freeze (our drawings have up to 30 xrefs in them).
Solution = Autolisp routine where user clicks on the layers, and a script is generated automatically.

The following code works perfectly:

(defun c:sgen ()

(setq TheScript (open "c:/layfrz.txt" "W"))
(write-line "-layer" TheScript)

(while (setq xall (nentsel "\nSelect Layer to Add to Script or hit enter to finish"))
(setq eList (entget (car xall)))
(setq xLayer (cdr (assoc 8 elist)))
(setq theline (strcat "&" xlayer "&"))
(write-line "f" TheScript)
(write-line theline TheScript)
)
(close TheScript)
)

I then jump into the text file, find and replace & with " and save as .scr file.

QUESTION: Is there any way to highlight the selection set as the user selects it. It seems that a combination of (redraw 3) and nentsel doesn't work, can anyone think of another way/solution to the problem?

Thanks very much

[pbejse]

One way.

(sssetfirst nil (setq whileObjs (ssadd (car xall) whileObjs )))

Something like this. 

(defun c:sgen (/ TheScript whileObjs xall eList xLayer theline)
(setq TheScript (open "c:/layfrz.txt" "W"))
(write-line "-layer" TheScript)
(setq whileObjs (ssadd))
(while (setq xall (nentsel "\nSelect Layer to Add to Script or hit enter to finish"))
	(sssetfirst nil (setq whileObjs (ssadd (car xall) whileObjs )) )     
	(setq eList (entget (car xall)))
	(setq xLayer (cdr (assoc 8 elist)))
	(setq theline (strcat "&" xlayer "&"))
	(write-line "f" TheScript)
	(write-line theline TheScript)
)
(close TheScript)
(sssetfirst nil)(princ)
)

Or you can use SSGET  and process those entities on one go, you can still select the entities individually anyway

(defun c:sgen (/ TheScript objects xall eList xLayer theline)
(setq TheScript (open "c:/layfrz.txt" "W"))
(write-line "-layer" TheScript)
(setq objects (ssget))      
(repeat (sslength objects)
      	(setq xall (ssname objects 0))
	(setq eList (entget xall))
	(setq xLayer (cdr (assoc 8 elist)))
	(setq theline (strcat "&" xlayer "&"))
	(write-line "f" TheScript)
	(write-line theline TheScript)
	(ssdel xall objects)
      
)
(close TheScript)
(princ)
)

[Anonymous]

Of course!

Right on the money, cheers Pbejse

[pbejse]

---

@Anonymous wrote:

Of course!

Right on the money, cheers Pbejse

---

You are Welcome nickelson, Glad it work ed for you 🙂

[Lee_Mac]

How about something like:

(defun c:sgen ( / ent file fn lay l1 l2 )
    (while
        (progn (setvar 'ERRNO 0)
            (setq ent (car (nentsel "\nSelect Layer to Add to Script <Done>: ")))
            (cond
                (   (= 7 (getvar 'ERRNO))
                    (princ "\nMissed, Try Again.")
                )
                (   (null ent)
                    nil
                )
                (   (not (member (setq lay (cdr (assoc 8 (entget ent)))) l2))
                    (redraw ent 3)
                    (setq l1 (cons ent l1)
                          l2 (cons "," (cons lay l2))
                    )
                    (princ (strcat "\nAdded Layer: " lay))
                )
                (   (princ (strcat "\nLayer " lay " already selected."))   )
            )
        )
    )
    (if (and l2 (setq file (open (setq fn "c:/layfrz.txt") "w")))
        (progn
            (write-line "_.-layer" file)
            (write-line "_F" file)
            (write-line (apply 'strcat (cdr l2)) file)
            (close file)
            (startapp "notepad" fn)
        )
    )
    (foreach e l1 (redraw e 4))
    (princ)
)

[Kent1Cooper]

---

@Anonymous wrote:

... Autolisp routine where user clicks on the layers, and a script is generated automatically.
...

(defun c:sgen ()

(setq TheScript (open "c:/layfrz.txt" "W"))
(write-line "-layer" TheScript)

(while (setq xall (nentsel "\nSelect Layer to Add to Script or hit enter to finish"))
(setq eList (entget (car xall)))
(setq xLayer (cdr (assoc 8 elist)))
(setq theline (strcat "&" xlayer "&"))
(write-line "f" TheScript)
(write-line theline TheScript)
)
(close TheScript)
)

I then jump into the text file, find and replace & with " and save as .scr file.
....

---

Apart from the highlighting question, I have some suggestions.

You can make it a .scr file from the beginning, and not need to save it to a different file type:

(setq TheScript (open "c:/layfrz.scr" "W"))
 

If you don't have spaces in any Layer names, you don't need quotation marks around them.  But assuming you do [or you might sometimes], you can write the lines with the quotation marks directly, rather than with a substitute character:

(setq theline (strcat "\"" xlayer "\""))

-- or --

(setq theline (strcat (chr 34) xlayer (chr 34)))
 

That way, you can just use the script immediately -- no need to open it up and "fix" anything about it.

Also, don't you need to finish Layer with a ""?  [That is, doesn't your Script leave you at the Layer prompt, and you need to hit Enter or Escape to finish the Layer command?]

You can also freeze all the Layers in one Freeze option, instead of using a separate one for each Layer, by making a comma-separated list of Layer names:

(defun c:sgen ()

  (setq

    TheScript (open "c:/layfrz.scr" "W")

    theline "" ; starting empty string

  ); setq
  (while (setq xall (nentsel "\nSelect object on Layer to Add to Script or Enter to finish"))
    (sssetfirst nil (setq whileObjs (ssadd (car xall) whileObjs))); [pbejse's addition]
    (setq theline (strcat (cdr (assoc 8 (entget (car xall)))) ","))
  ); while
  (write-line "-layer f" TheScript)

  (write-line (strcat "\"" theline "\"") TheScript)

;  or, if there won't be any spaces in layer names, just:

;  (write-line theline TheScript)

  (write-line "" TheScript); end Layer command
  (close TheScript)
  (sssetfirst nil) (princ); [pbejse's addition]
); defun

You might also be able to (strcat) some or all of those (write-line) strings together.

[Lee_Mac]

A good point regarding the layers containing spaces, I had overlooked that:

(defun c:sgen ( / ent file fn lay l1 l2 )
    (while
        (progn (setvar 'ERRNO 0)
            (setq ent (car (nentsel "\nSelect Layer to Add to Script <Done>: ")))
            (cond
                (   (= 7 (getvar 'ERRNO))
                    (princ "\nMissed, Try Again.")
                )
                (   (null ent)
                    nil
                )
                (   (not (member (setq lay (cdr (assoc 8 (entget ent)))) l2))
                    (redraw ent 3)
                    (setq l1 (cons ent l1)
                          l2 (cons "," (cons lay l2))
                    )
                    (princ (strcat "\nAdded Layer: " lay))
                )
                (   (princ (strcat "\nLayer " lay " already selected."))   )
            )
        )
    )
    (if (and l2 (setq file (open (setq fn "c:/layfrz.scr") "w")))
        (progn
            (write-line "_.-layer" file)
            (write-line "_F" file)
            (write-line (strcat "\"" (apply 'strcat (cdr l2)) "\"") file)
            (write-line "" file)
            (close file)
            (startapp "notepad" fn)
        )
    )
    (foreach e l1 (redraw e 4))
    (princ)
)

Kent, you might want to add some error trapping in case the 'scr' file cannot be opened for some reason, resulting in a null file descriptor. Also - localise your variables!

[Kent1Cooper]

---

@Lee_Mac wrote:

.... 

Kent, you might want to add some error trapping in case the 'scr' file cannot be opened for some reason, resulting in a null file descriptor. Also - localise your variables!

---

Yeah, I would, normally.  I was pretty much leaving their code [with one of pbejse's highlighting approaches incorporated] alone, except for the particular aspects I was suggesting to adjust.

[Anonymous]

@Lee_Mac - That's definitely taking things up a notch, cheers! I'll have to have a proper look at all the parts this morning and work out exactly what's happening in there. Having differenet approaches to the same problem is always helpful when learning a new skill.

@Kent1Cooper - Great suggestions, I was definitely wondering about those things. I had a feeling there would be a way to achieve a finished script but wasn't quite sure how. Thanks very much!

This one's gonna save a few hours I reckon

[Anonymous]

Ok so now I have a succesful layer freeze script generator, but I just had another idea. i want to do the same thing again, but for layer colours, where user selects the layer, then inputs integer for desired colour.

The only way I know how to achieve selection of layers with actions on each selection is using the

(while (setq xall (nentsel...))

(do all this stuff)

)

 code, as in the previous routine.

But adding a  (setq TheColour (getint "\nSelect Colour for layer") on the next line causes routine to finish, as it's expecting another nentsel and enter means end the while loop...

Can anyone give me a push in the right direction for this selection/colour input issue?

Thanks very much

[pbejse]

---

@Anonymous wrote:

Ok so now I have a succesful layer freeze script generator, but I just had another idea. i want to do the same thing again, but for layer colours, where user selects the layer, then inputs integer for desired colour.
 

---

Change the color of the layer in real time? Or selecet colors for layer and write the result to a file?

[Anonymous]

I want to write to file, for multiple layers

(setq theColour (getint "\nWhich Colour do yuo wish to make this layer"))

(write-line "c " TheScript )

(write-line theline thescript) ;where theline is the layer name elicited in the same way as previous script

[pbejse]

With Lee's code? or on your original code?

[pbejse]

anyhoo.. with Lee's code

change this

 (   (not (member (setq lay (cdr (assoc 8 (entget ent)))) l2))
                    (redraw ent 3)
                    (setq l1 (cons ent l1)
                          l2 (cons "," (cons lay l2))
                    )
                    (princ (strcat "\nAdded Layer: " lay))
                )

 to

(   (not (assoc (setq lay (cdr (assoc 8 (entget ent)))) l2))
                    (redraw ent 3)
                    (setq TheColour (acad_colordlg 7 nil))
                    (setq l1 (cons ent l1)
                          l2 (cons (list lay (itoa TheColour)) l2)
                    )
                    (princ (strcat "\nAdded Layer: " lay))
                )

 and this

(if (and l2 (setq file (open (setq fn "c:/layfrz.scr") "w")))
        (progn
            (write-line "_.-layer" file)
            (write-line "_F" file)
            (write-line (strcat "\"" (apply 'strcat (cdr l2)) "\"") file)
            (write-line "" file)
            (close file)
            (startapp "notepad" fn)
        )
    )

 to

(if (and l2 (setq file (open (setq fn "c:/laycol.scr") "w")))
        (progn
            (write-line "_.-layer" file)
            (write-line "_C" file)
            (foreach itm l2
            (write-line (cadr itm) file)
            (write-line (strcat "\"" (car itm) "\"") file)
                  )
	    (write-line "" file)
            (close file)
            (startapp "notepad" fn)
        )
    )

I'm pretty sure he has something else in mind for this, for now you try the snips above.

no disrespect Lee  😉

BTW: before i can change a color of a line on the code. but not anymore. what gives?

[Anonymous]

Great, thanks again Pbejse. I will put the code together soon and try it - I got sidetracked by work (I hate it when that happens)

Not too sure about the line colour thing

[Anonymous]

Yep, works perfectly, exactly what I was after! Great work

[pbejse]

Glad i could help  🙂

[Lee_Mac]

---

@pbejse wrote:

I'm pretty sure he has something else in mind for this, for now you try the snips above.

no disrespect Lee  😉

---

No worries pbejse, glad you could help out