Jump to content

<-- this guy needs some help


btraemoore

Recommended Posts

Yup, sort of... i can write a snippet for you.... you didnt answer my question though,
in the drawing there wouldn't be 2 layers with identical names, if there is ELECTRICAL/1/HIDDEN it will be renamed to elec and then move to the next layer in question.. here is the coding that i have so far

 

(vl-load-com)
(setq acadDocument (vla-get-activedocument (vlax-get-acad-object)))
(setq layertable (vla-get-layers acadDocument))
	(while (setq Lay (tblnext "LAYER" 1))
		(setq layLT (cdr (assoc 6 lay)) 
			  layCOLOR (itoa (cdr (assoc 62 lay)))
			  layNM (cdr (assoc 2 lay))
			  claylst (list laycolor laylt)
		);setq
			(setq f (open "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt" "r"))
			(while (/= dataline1 "eof")
				(setq dataline1 (read-line f))
				(setq k 1)
				(setq a "")
				(setq lst nil)
				(setq laylst nil)
				(repeat (strlen dataline1)
						(if (= (substr dataline1 k 1) "\t")
							(progn
								(setq lst (append lst (list a)))
								(setq a "")
							);progn
							(setq a (strcat a (substr dataline1 k 1)))
						);if
						(setq k (+ k 1))
				);repeat
				(setq lst (append lst (list a)))
				(setq lstlaynm (car (cdr (cons 1 lst))))
					(if (/= lstlaynm laynm)
						(setq clst (cdr (cdr (cons 1 lst))))
						(if (and (= (nth 1 clst)(nth 1 claylst))(= (nth 2 clst)(nth 2 claylst)))

Link to comment
Share on other sites

  • Replies 39
  • Created
  • Last Reply

Top Posters In This Topic

  • btraemoore

    22

  • pBe

    14

  • MSasu

    3

  • BIGAL

    1

Top Posters In This Topic

btraemoore.

First of all, dont put the read-line function inside the while loop.Read and parse the text file once to create a list

 

Where laylst is the data from reading and parsing the file

Lets say you have the layer ELECTRICAL 7 HIDDEN

(defun c:moore (/ _match laylst a coll tlst)
[b][color=blue](defun _match  (nm col lt lst / n f)[/color][/b]
[b][color=blue]    (while (and (setq n (car lst)) (not f))[/color][/b]
[b][color=blue]          (if (and[/color][/b]
[b][color=blue]                    (wcmatch (strcase nm) (strcat (car n) "*"))[/color][/b]
[b][color=blue]                    (eq col (cadr n))[/color][/b]
[b][color=blue]                    (eq (strcase lt) (last n)))[/color][/b]
[b][color=blue]                (setq f T)[/color][/b]
[b][color=blue]                (setq lst (cdr lst)))) (car n))[/color][/b]
(vl-load-com)
(setq acadDocument (vla-get-activedocument (vlax-get-acad-object)))
(setq layertable (vla-get-layers acadDocument))
[color=olive];;; example Result from a parsing routine  ;;;[/color]
[color=olive](setq laylst '(("CPRT" 4 "CONTINUOUS") ("CPRT" 7 "CONTINUOUS")[/color]
[color=olive]          ("CUTLINE" 5 "HIDDEN") ("CUTLINE" 7 "HIDDEN")[/color]
[color=olive]          ("DASHED" 2 "DASHED") ("DASHED" 2 "PHANTOM")[/color]
[color=olive]          ("DASHED" 7 "PHANTOM") ("DEFPOINTS" 7 "CONTINUOUS")[/color]
[color=olive]          ("DEPT" 3 "CONTINUOUS")  ("DEPT" 7 "CONTINUOUS")[/color]
[color=olive]          ("DIM" 2 "CONTINUOUS") ("DIM" 7 "CONTINUOUS")[/color]
[color=olive]          ("DIMN" 1 "CONTINUOUS") ("DIMN" 7 "CONTINUOUS")[/color]
[color=olive]          ("ELEC" 1 "HIDDEN") ("ELEC" 7 "HIDDEN")))[/color]                
(while (setq a (tblnext "LAYER" (null a)))
       (setq coll (list (cdr (assoc 2 a))
                                (cdr (assoc 62 a))
                                (cdr (assoc 6 a))))
 (if (and (setq tlst (vl-remove-if-not  '(lambda (ly)
                             (eq (strcase (substr (car ly) 1 1))
                                 (strcase (substr (car coll) 1 1)))) laylst))
           (setq newname (_match (car coll)(cadr coll)(last coll) tlst))
                        )
        (vla-put-name (vla-item layertable (car coll)) newname))
     )
     )

 

It reduces the list per loop depending on the first character of the layername

Then use _match routine for "comparison" test if found returens the New Layer Name

 

HTH

 

BTW: what i meant by this

 

ELECTRICAL/1/HIDDEN will be ELEC, and ELECTRICAL/7/HIDDEN will also be ELEC, is that right?

 

is it one or the other? because you have two lines ELEC 1 HIDDEN ELEC 7 HIDDEN included on the text file.

Link to comment
Share on other sites

im having a hard time understanding what you did with the _match, after did you basically compare everything at the same time?

Link to comment
Share on other sites

This is where I'm at so far, now i am going to try to use the wcmatch to narrow down my name selection

(defun fixlay (/)
(vl-load-com)
(setq acadDocument (vla-get-activedocument (vlax-get-acad-object)))
(setq layertable (vla-get-layers acadDocument))
	(setq f (open "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt" "r"))
	(while (setq Lay (tblnext "LAYER" 1))
		(setq oldlayLT (cdr (assoc 6 lay)) 
			oldlayCOLOR (itoa (cdr (assoc 62 lay)))
			oldlayNM (cdr (assoc 2 lay))
			oldcompLST (list laycolor laylt))
		(while (/= dataline1 "eof")
			(setq dataline (read-line f)
				k 1
				a ""
				LST nil)	
			(repeat (strlen dataline1)
				(if (= (substr dataline k 1) "\t")
					(progn
						(setq LST (append LST (list a)))
						(setq a "")
					);progn
					(setq a (strcat a (substr dataline k 1)))
				);if
				(setq k (+ k 1))
			);repeat
		(setq LST (append LST (list a)))
		(setq newlayNM (car (cdr (cons 1 LST)))
			newcompLST (cdr (cdr (cons 1 LST)))
			newlayLT (cdr (cdr LST))
			newlayCOLOR (atoi (car (cdr lst))))
			(if (/= newlayNM oldlayNM)
				(progn
					(if (and (= (nth 1 oldcompLST)(nth 1 newcompLST))(= (nth 2 oldcompLST)(nth 2 newcompLST)))
						(setq newlayNMLST (append newlayNMLST (list newlayNM)))
					);if
				);progn
					(if (/= oldlayLT newlayLT)
						(vlax-put-property LAY 'Linetype newlayLT));if
					(if (/= oldlayCOLOR newlayCOLOR)
						(vlax-put-property LAY 'Color newlayCOLOR)
					);if
			);if
		);while
		
	);while

Link to comment
Share on other sites

The second line is the new Nane, Linetype and Color. So its not jsut the name but also the lt and color

 

CLINE 7 CENTER

CLINES 7 CENTER2

 

Load layers (revert to original state) and Transalte (This name to that) at the same time. I've seen a lot Layer routine out there, but this one takes the cake :lol:

I can modify the code i posted to do just that. I'll look into it later.

Link to comment
Share on other sites

hey, good morning. alright, so i tried to read the code this morning and i cant seem to understand what it is doing. I mean i get that it fixes it, but i guess i dont understand the coding for the _match, if you could comment it out for me so i can learn from it that would be awesome :)

 

 

 

edit: its very important that i learn from it, especially when i have no one to teach me. Im only about a month in to coding...

Link to comment
Share on other sites

Good for you btraemoore. Should we proceed with that approach? If YES, i still need to modify _Match sub-routine Would you like maintain the sequence the way your code is written? Am i correct in my assumption on the previous post?

 

CLINE 7 CENTER

 

Would you want to replace your code the way the file is read and stored on a list?

 

On another note. Hang around and read the posts on this forum, You'll be amaze how one task can be coded in so many different ways. On my part i'm still a novice and still have much to learn. ;)

Link to comment
Share on other sites

CLINE 7 CENTER yes this is ultimately what i am trying to do, i guess i prefer the syntax the way i write because its easier for me to read and to learn from. I am still playing around with the code that i wrote... soooo many bugs i keep getting a stringp nil error... im guessing its because its not moving to the next layer in the table... visual lisp is extremely new for me, but yes you have the right idea of what i want to do with this routine. Thank you very much for your help :)
Link to comment
Share on other sites

so, this is where i am at. I'm not getting any errors, but its not reading past the first layer

 

 

(defun C:flay ()
(vl-load-com)
(setq acadDocument (vla-get-activedocument (vlax-get-acad-object)))
(setq layertable (vla-get-layers acadDocument))
(setq f (open "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt" "r"))
(setq Lay (tblnext "LAYER" 1))
(setq count 0)
(setq mcnt 0)
(repeat laycnt
	(setq oldlayLT (cdr (assoc 6 lay)) 
		oldlayCOLOR (itoa (cdr (assoc 62 lay)))
		oldlayNM (cdr (assoc 2 lay))
		oldcompLST (list oldlayCOLOR oldlayLT)
		dataline (read-line f))
	(while (/= dataline nil) 
		(setq k 1
			a ""
			LST nil)	
		(repeat (strlen dataline)
			(if (= (substr dataline k 1) "\t")
				(progn
					(setq LST (append LST (list a)))
					(setq a "")
				)
				(setq a (strcat a (substr dataline k 1)))
			)
			(setq k (+ k 1))
		)
	(setq LST (append LST (list a)))
	(setq mlst (append mlst (list lst)))
	(setq newlayNM (car (cdr (cons 1 LST)))
		newcompLST (cdr (cdr (cons 1 LST)))
		newlayLT (cdr (cdr LST))
		newlayCOLOR (car (cdr lst))) 
		(if (= newlaynm oldlaynm)
			(progn 
			(setq count (+ 1 count))
				(if (and (= oldlaycolor newlaycolor)(= oldlaylt newlaylt))
					(progn
						(setq newlayNMLST (append newlayNMLST (list newlayNM)))
					)
				)
			)
			(setq match (append match (list oldlaynm)) mcnt (+ mcnt 1));;; just a test	
		)
		(princ oldlaynm)(princ " ");;;another test
		(setq dataline (read-line f))
	)
	
	
)(setq Lay (tblnext "LAYER"))
)



(defun c:Lcnt()
(setq acadDocument (vla-get-activedocument (vlax-get-acad-object)))
(setq layertable (vla-get-layers acadDocument))
(setq Lay (tblnext "LAYER" 1))
(while lay
	(setq oldlayNM (cdr (assoc 2 lay)))
	(setq laycnt (append laycnt (list oldlaynm)))
	(setq lay (tblnext "layer"))
)
(setq laycnt (length laycnt))
)

(defun c:fixlay(/ laycnt)
(command "-purge" "a" "" "n")
(c:lcnt)
(c:flay)
);defun

 

 

this is what i get in my command box after running the routine.

Command: 0 BORDER ELEC MATCH POWER SYMBOLS TEXT UTIL BALLOON nil

 

Command: !match

("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"

"0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"

"0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"

"0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"

"0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"

"0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0"

"0" "0" "0" "0" "0" "0" "0" "0")

 

any suggestions?

Link to comment
Share on other sites

so, this is where i am at. I'm not getting any errors, but its not reading past the first layer

any suggestions?

 

 

(= newlaynm oldlaynm) evaluates to nil as variable LAY remains as "0" thru the entire repeat/loop [Hence you get this -> ("0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" "0" ....)] because you had this (setq Lay (tblnext "LAYER")) outside repeat. I wouldsuggest you use (wcmatch oldlaynm (strcat newlaynm "*"))

 

Anyhoo, thats sut one of the "bugs" btraemoore.

For now have a look-see at this code

(defun c:moore (/ _match _delFinder _entmod laylst
                 f a laylst coll  newname Thislayer)
(vl-load-com)
(defun _match  (nm col lt lst / n fn)
   (while (and (setq n (car lst)) (not fn))
         (if (and
                   (wcmatch (strcase nm) (strcat (car n) "*"))
                   (= col (atoi (cadr n)))
                   (eq (strcase lt) (last n)))
               (setq fn  [b][color=blue](cadr lst)[/color][/b])
               (setq lst [b][color=blue](cddr lst)[/color][/b]))) fn)
(defun _delFinder  (str md / d l str)
     (while (setq d (vl-string-position md str nil T))
           (setq l (cons (substr str (+ 2 d)) l)
                 str (substr str 1 d)))
     (cons str l)
     )
(setq _entmod (lambda (v dx entg)
(entmod (subst (cons dx v)(assoc dx entg) entg))))     
(if (setq laylst nil
            f (findfile "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt"))
      (progn
         (setq f (open f "r"))
          (while (setq a (read-line f))
       (setq laylst (cons (_delFinder a 32) laylst))   
                 )
         (setq laylst (reverse laylst))
         (close f) 
(while (setq a (tblnext "LAYER" (null a)))
  (cond ((and
          (not (member (setq lyn  (cdr (assoc 2 a))) '("DEFPOINTS" "0")))
               (setq coll (list lyn (cdr (assoc 62 a))(cdr (assoc 6 a))))
 (setq newname (_match lyn (cadr coll)(last coll) laylst))
 (setq Thislayer (entget (tblobjname "LAYER" lyn))
       Thislayer [b][color=blue](if (not (tblsearch "LAYER" (car newname)))
                                   (_entmod (car newname) 2 Thislayer)
                                   Thislayer)
[/color][/b]               Thislayer (_entmod (atoi (cadr newname)) 62 Thislayer)
              Thislayer (_entmod (caddr newname) 6 Thislayer))
               )))
             )
         )
     )(princ)
)

 

I tried to write it without Vlisp (execpt vl-string-position : run out of time) Also i notice you have "0" include on the list and "2" right after that. You cannot rename layer "0"

 

Tell me what part you dont undertstand, then i'll put a comment on those parts.

 

HTH

 

CODE UPDATED:

Remove function for reduce list

Remove m variable

Allow a totally different name if the 1st lien is a match

If new layer name exist change the Color and/or Linetype.

Edited by pBe
Update Code
Link to comment
Share on other sites

 (defun c:moore (/ _match _delFinder _entmod laylst
	  f a laylst coll tlst newname Thislayer)
(vl-load-com)
(defun _match  (nm col lt lst / n fn)
   (while (and (setq n (car lst)) [color="red"](not fn)[/color])
  (if (and
	    (setq m (cdr lst))
	    (wcmatch (strcase nm) (strcat (car n) "*"))
	    (= col (atoi (cadr n))) 
	    (eq (strcase lt) [color="red"](last n)[/color])
	    (eq (car n)[color="red"](caar m)[/color]))
	(setq fn  (car m))
	(setq lst (cdr m)))) fn)
(defun _delFinder  (str md / d l str)
     (while (setq d (vl-string-position md str nil T))
    (setq l (cons (substr str (+ 2 d)) l)
	  str (substr str 1 d)))
     (cons str l)
     )
(setq _entmod ([color="red"]lambda[/color] (v dx entg)
(entmod (subst (cons dx v)(assoc dx entg) entg))))     
(if (setq laylst nil
      f (findfile "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt"))
  (progn
  (setq f (open f "r"))
   (while (setq a (read-line f))
(setq laylst (cons (_delFinder a 32) laylst))   
	  )
  (setq laylst (reverse laylst))
  (close f) 
(while (setq a (tblnext "LAYER" (null a)))
  (cond ((and
   (not (member (setq lyn  (cdr (assoc 2 a))) '("DEFPOINTS" "0")))
	(setq coll (list lyn (cdr (assoc 62 a))(cdr (assoc 6 a))))
   (setq tlst (vl-remove-if-not  '(lambda (ly)
     (if (numberp (read lyn))
       (wcmatch (car ly) "#*")
       (eq (strcase (substr (car ly) 1 1))
	   (strcase (substr lyn 1 1))))) laylst))
 (setq newname (_match lyn (cadr coll)(last coll) tlst))
	(not (tblsearch "LAYER" (car newname)))
 (setq Thislayer (entget (tblobjname "LAYER" lyn))
Thislayer (_entmod (car newname) 2 Thislayer)
       Thislayer (_entmod (atoi (cadr newname)) 62 Thislayer)
       Thislayer (_entmod (caddr newname) 6 Thislayer))
	)))
      )
  )
     )(princ)
)
)

the parts in red are the parts that i dont understand, but in a basic overview if you could just put a few comments after the major functions so i can grasp how the code works that would be amazing.

Link to comment
Share on other sites

(defun _match  (nm col lt lst / n fn)

   (while (and (setq n (car lst)) [b][color=sienna](not fn)[/color][/b])

[b][color=blue];;  While the variable fn  is nil the expression will evaluate to T [/color][/b]
[b][color=blue];;  as well as variable n is not nil    [/color][/b]

         (if (and
     (setq m (cdr lst))
     (wcmatch (strcase nm) (strcat (car n) "*"))
     (= col (atoi (cadr n))) 

     (eq (strcase lt) [b][color=sienna](last n)[/color][/b])

[color=blue][b];;  if varialbe n is T it will be a 3 element list   [/b][/color]
[color=blue][b];;  say value for n is ("ELEC" 1 "HIDDEN") last of n is "HIDDEN" [/b][/color]

     (eq (car n)[b][color=sienna](caar m)[/color][/b]))

[b][color=blue];;  if variable m is not nil it will be the rest of the variable lst[/color][/b]
[b][color=blue];;  in this case lst is the reduce list of the generated  list      [/color][/b]
[b][color=blue];;  from the text file. say ((ELEC 1 "HiDDEN")("ELEC" 7 "HIDDEM"))  [/color][/b]
[b][color=blue];;  (caar is the first element of the first element of the list [/color][/b]
[b][color=blue];;  similar to (Car (car lst))[/color][/b]    

 (setq fn  (car m))
 (setq lst (cdr m)))) fn)

 

for lambda

http://www.cadtutor.net/forum/showthread.php?52127-Mapcar-lambda-Description

 

Did the routine work for you?

Edited by pBe
Link to comment
Share on other sites

I changed a few layer names and layer colors in the current drawing that im in and ran it, it didn't error out but it also didn't change anything.

Link to comment
Share on other sites

I changed a few layer names and layer colors in the current drawing that im in and ran it, it didn't error out but it also didn't change anything.

 

Well, there's not much i can do about that now. Unless i have a copy of the files you are using (TXT/DWG). Otherwise it will all guess work from hereon. Come to think of it, its been like that form the start :lol:.

 

Here are the conditions:

*The data from the text file should be like this: ELEC 1 HIDDEN use for comparison and ELEC 7 HIDDEN for new values. if the layer names doesnt match, the _match function will evaluate to nil, unless that is your intention all along.

 

*The Layer already exists. we cant have two similar names on the Layer collection

 

It WOULD work in these cases

Elecrical 1 HIDDEN to ELEC 7 HiDDEN

Dimension 2 Continuous to DIM 4 DASHED

 

granting the text file format is

ELEC 1 HIDDEN

ELEC 7 HIDDEN

DIM 2 CONTINUOUS

DIM 4 DASHED

 

You see now? as long the the first line is a match

wcmatch DIMENSION DIM*

2 - 2

HIDDEN - HIDDEN

Only then it will rename the Layer name

 

But it wont change if

DIM 3 HIDDEN

DIM 4 DASHED as 3 is not a match.

 

The important thing there is the 1st of the pair (the comparison line)

Now if you need the 2nd line of the pair as deifferent name. it can still be done. but i need to see the bigger picture.

 

---- >> pBe

Edited by pBe
Link to comment
Share on other sites

Well, there's not much i can do about that now. Unless i have a copy of the files you are using (TXT/DWG). Otherwise it will all guess work from hereon. Come to think of it, its been like that form the start :lol:.

 

Here are the conditions:

*The data from the text file should be like this: ELEC 1 HIDDEN use for comparison and ELEC 7 HIDDEN for new values. if the layer names doesnt match, the _match function will evaluate to nil, unless that is your intention all along.

 

*The Layer already exists. we cant have two similar names on the Layer collection

 

It WOULD work in these cases

Elecrical 1 HIDDEN to ELEC 7 HiDDEN

Dimension 2 Continuous to DIM 4 DASHED

 

granting the text file format is

ELEC 1 HIDDEN

ELEC 7 HIDDEN

DIM 2 CONTINUOUS

DIM 4 DASHED

 

You see now? as long the the first line is a match

wcmatch DIMENSION DIM*

2 - 2

HIDDEN - HIDDEN

Only then it will rename the Layer name

 

But it wont change if

DIM 3 HIDDEN

DIM 4 DASHED as 3 is not a match.

 

The important thing there is the 1st of the pair (the comparison line)

Now if you need the 2nd line of the pair as deifferent name. it can still be done. but i need to see the bigger picture.

 

---- >> pBe

 

LOL, thanks for all your help, bro. im going to take a break from it for a bit, and it seems that you need to... ill come back to it in a few days... give my self time to rethink what im doing and what i want my ultimate goal to be... Thanks again for the lessons..

Link to comment
Share on other sites

 [/color][/b]

[b][color=#0000ff][/color][/b]

[color=black]To work with this conditions:[/color]

[b]CLINE 7 CENTER :

[color=black]CLINE 7 CENTER ;

[b]CLINES[/b] 7 [b]CENTER2[/b] ;

[color=black]

[b]COLUMN 1 CONTINUOUS :

COL 1 CONTINUOUS ;

[b]CONC[/b] 1 [b]HIDDEN[/b] ;

 

[b]CUTLINE 5 HIDDEN[/b] [b]:

CUTLINE 5 HIDDEN ;

CUTLINE [b]7 [/b]HIDDEN ;

Link to comment
Share on other sites

I started over yesterday and came up with this, im still thinking about how i want it to work for the names, could i implement _match in here some how?

and i fixed the format of the .txt, to not be able to have everything in white... so there is only 1 selection for each name..

 

(defun C:flay (/ layerTable standardList currentLayer currentCompare)
(vl-load-com)
(setq layerTable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
 (setq standardList (readTxt "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt"))
(setq layerCount 0)
 	(repeat (vla-get-count layerTable)
  	(setq currentLayer (vla-item layerTable layerCount))
	(setq
	  	old_layername (vla-get-name currentLayer)
		old_color (vla-get-color (itoa currentLayer))
		old_linetype (vla-get-linetype currentLayer)
		old_layerData (list old_layername old_color old_linetype)
	);setq
  	(setq compareCount 0)
  	(while (/= compareCount (length standardList))
  		(setq currentCompare (splitstr (nth compareCount standardList) "\t"))
		(setq
			compare_layername (car currentCompare)
			compare_color (cadr currentCompare)
			compare_linetype (caddr currentCompare)
		);setq
		(if (= old_layername compare_layername)
			(progn
			(vla-put-color currentLayer (atoi compare_color))
			(vla-put-linetype currentlayer compare_linetype)
			);progn
		);if
	  	(setq compareCount (+ compareCount 1))
	  	(setq currentCompare nil compare_layername nil compare_color nil compare_linetype nil)
	);while
	
  	(setq compareCount nil)
  	(setq layerCount (+ layerCount 1))
)(princ "changed ")(princ layercount)(princ " layers")
)


(defun readTxt(txtFile / dataList line)
(setq f (open txtFile "r"))
 	(setq dataList '())
 	(while (setq line (read-line f))
	(setq dataList (cons line dataList))
);while
 	(close f)
 	(setq dataList (reverse dataList))
);defun

(defun splitstr (str delim / ptr lst)
(while (setq ptr (vl-string-search delim str))
	(setq lst (cons (substr str 1 ptr) lst))
	(setq str (substr str (+ ptr 2)))
)
(reverse (cons str lst))
); splitstr

Link to comment
Share on other sites

Finally got it done :)

 

(defun C:flay (/ new_nameList layerTable standardList currentLayer currentCompare nilList  compare_layerdata
	nil_layername nil_color nil_linetype layerlist pos new_namelist )
(vl-load-com)
(setq
	layerTable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
 		standardList (readTxt "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardlayers.txt")
	layerCount 0
);setq
 	(repeat (vla-get-count layerTable)
  	(setq currentLayer (vla-item layerTable layerCount))
	(setq
	  	old_layername (vla-get-name currentLayer)
		old_color (vla-get-color currentLayer)
		old_linetype (vla-get-linetype currentLayer)
		old_layerData (list old_layername old_color old_linetype)
		compareCount 0
		existsflag nil
	);setq
  	(setq layerlist (append layerlist (list old_layername)))
	(while (and (/= compareCount (length standardList))(/= existsflag T))
  		(setq currentCompare (splitstr (nth compareCount standardList) "\t"))
		(setq
			compare_layername (car currentCompare)
			compare_color (cadr currentCompare)
			compare_linetype (caddr currentCompare)
		);setq
		(if (= old_layername "0")
			(setq existsflag T)
			(progn
				(if (= old_layername compare_layername)
					(progn
					(vla-put-color currentLayer (atoi compare_color))
					(vla-put-linetype currentlayer compare_linetype)
					(vl-remove (nth compareCount standardList) standardList)
						(setq
							existsflag T
							compareCount (- 1 compareCount)
						);setq
					);progn
				);if	
			);progn
		);if
	  	(setq
	  		compareCount (+ compareCount 1)
	  		currentCompare nil
	  		compare_layername nil
	  		compare_color nil
	  		compare_linetype nil
	  	);setq
	);while
	(if (= existsflag nil)
		(setq nilList (append nilList (list old_layerData)))
	);if
  	(setq
  		compareCount nil
  		layerCount (+ layerCount 1)
  	);setq
);repeat 
(if (/= nullist nil)
   (progn
 	(princ "layer/layers ")(princ nillist)(princ " are not standard")
   );progn
);if
(setq layerCount 0)
(repeat (length nilList)
	(setq currentLayer (nth layerCount nilList))
	(setq
		nil_layername (car currentLayer)
		nil_color (cadr currentLayer)
		nil_linetype (strcase (caddr currentLayer))
		compareCount 0
		existsflag nil
	);setq
	(while (and (/= compareCount (length standardList))(/= existsflag T))
		(setq currentCompare (splitstr (nth compareCount standardList) "\t"))
		(setq
			compare_layername (car currentCompare)
			compare_color (cadr currentCompare)
			compare_linetype (strcase (caddr currentCompare))
			compare_layerData (list compare_layername compare_color compare_linetype)
		);setq
		(if (= (atoi compare_color) nil_color)
			(progn
				(if (= compare_linetype nil_linetype)
					(progn
						(setq pos (vl-position compare_layername layerlist))
					  	(if (= pos nil)
						 	(progn
					  			(command "-rename" "la" nil_layername compare_layername)
					  			(setq layerlist (append layerlist (list compare_layername)))
								(vl-remove (nth compareCount standardList) standardList)
								(setq
									existsflag T
									compareCount (- 1 compareCount)
									new_namelist (append new_namelist (list compare_layerdata))
								);setq
							  );progn
						);if
					);progn
				);if
			);progn
		);if
		(setq
			compareCount (+ compareCount 1)
			currentCompare nil
			compare_layername nil
			compare_color nil
			compare_linetype nil
		);setq
	);while
	(setq
		compareCount nil
		layerCount (+ layerCount 1)
	);setq
)(princ "changed ")(princ nilList)
(princ " to ")(princ new_nameList)
)


(defun readTxt(txtFile / dataList line)
(setq f (open txtFile "r"))
 	(setq dataList '())
 	(while (setq line (read-line f))
	(setq dataList (cons line dataList))
);while
 	(close f)
 	(setq dataList (reverse dataList))
);defun

(defun splitstr (str delim / ptr lst)
(while (setq ptr (vl-string-search delim str))
	(setq lst (cons (substr str 1 ptr) lst))
	(setq str (substr str (+ ptr 2)))
)
(reverse (cons str lst))
); splitstr

 	
(defun c:fixlay()
(command "-purge" "a" "" "n")
(c:flay)
);defun

(c:fixlay)

Link to comment
Share on other sites

lol... well now im doing one for text styles.... im trying to figure out this error, in vlide im getting a warning "warning: redefinition of built-in symbol: VL-LOAD-COM". it also gives me to few arguments error.. ive never seen the warning before, and especially for vl-load-com you have any ideas?

 

 

(defun C:fixsty()
(vl-load-com)
(setq
	StyleTable (vla-get-textStyles (vla-get-activedocument (vlax-get-acad-object)))
 		standardList (readTxt "C:/Documents and Settings/moorerb/Desktop/scripting-lisp/standardStyles.txt")
	StyleCount 0
);setq
 	(repeat (vla-get-count StyleTable)
  	(setq currentStyle (vla-item StyleTable StyleCount))
	(setq
	  	old_Stylename (vla-get-name currentStyle)
		old_Font (vla-get-FontFile currentStyle)
		compareCount 0
		existsflag nil
	);setq
  	(setq Stylelist (append Stylelist (list old_Stylename)))
	(while (and (/= compareCount (length standardList))(/= existsflag T))
  		(setq currentCompare (splitstr (nth compareCount standardList) "\t"))
		(setq
			compare_Stylename (car currentCompare)
			compare_font (cadr currentCompare)
			
		);setq
		(if (= old_Stylename compare_Stylename)
			(progn
			(vla-put-fontfile currentStyle compare_font)
			(vl-remove (nth compareCount standardList) standardList)
				(setq
					existsflag T
					compareCount (- 1 compareCount)
				);setq
			);progn
		);if	
		(setq
	  		compareCount (+ compareCount 1)
	  		currentCompare nil
	  		compare_Stylename nil
	  		compare_color nil
	  		compare_linetype nil
	  	);setq
	);while
	(if (= existsflag nil)
		(setq nilList (append nilList (list old_Stylename)))
	);if
  	(setq
  		compareCount nil
  		StyleCount (+ StyleCount 1)
  	);setq
);repeat 
(if (/= nullist nil)
   (progn
 	(princ "Style/Styles ")(princ nillist)(princ " are not standard")
   );progn
);if
);defun

 

disregard i left ( ) out after defun... im an idiot

Edited by btraemoore
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...