Jump to content

HELP Looping 'Convert Bylaer colour and linetype'


Micko79

Recommended Posts

Hi all, I am new to Lisp and am having troubles looping the following lisp. I am trying to select objects and then put them on a layer relating to their colour and linetype. For example I want to select an object that has BYLAYER = RED and DASHED and then put it on a layer called 1DASHED. I have got it to run using the following code but because I used NENTSEL I can only pick one object at a time (and it works) I need it to loop to run through every object in an entire drawing but every loop I try I get an error saying VARITYP or something similar (at home now and dont have CAD to regen the error) I looked it up and it means I am refering to a selection set instead of a LIST. Please help looping this. I am desperate.

 

(defun C:QQQ ( / esl laycol )

 

(while (not (setq esl (nentsel)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

(setq LayCol (cdr (cadddr (tblsearch "layer" ( cdr(assoc 8 (entget (car esl)))))) ))

(setq LayLin (Cdr (cadr (cdddr (tblsearch "layer" ( cdr(assoc 8 (entget (car esl)))))) )) )

(setq LayName (strcat (rtos LayCol) LayLin))

 

(COMMAND "LAYER" "m" LayName "C" laycol LayName "Ltype" LayLin LayName "")

(COMMAND "CHPROP" esl "" "LA" LayName "C" "BYLAYER" "LType" "BYLAYER" "")

 

)

Link to comment
Share on other sites

Welcome to the forum Micko79 :)

 

Try This

 

(defun c:LayMod (/ aDoc lyrsColl ltpotd Lyrs ss ent nme)
 (vl-load-com)
 (setq aDoc  (vla-get-ActiveDocument (vlax-get-acad-object))
lyrsColl (vla-get-layers aDoc)
ltpotd  (vla-get-linetypes aDoc)
 )
 (defun _dxf (ent dx_) (cdr (assoc dx_ ent)))
 (defun _lyslst (/ Laylst)
   (while (setq a (tblnext "Layer" (null a)))
     (if (not (wcmatch (_dxf a 2) "*|*"))
(progn (setq lyp (tblsearch "Layer" (_dxf a 2)))
       (setq
  Laylst (append
    (list (_dxf a 2) (itoa (_dxf a 62)) (_dxf a 6))
    Laylst
  )
       )
)
     )
   )
   Laylst
 )
 (setq Lyrs (_lyslst))
 (if (ssget ":L" '((0 . "~VIEWPORT")))
   (progn
     (vlax-for itm (setq ss (vla-get-ActiveSelectionSet aDoc))
(setq nme (member (vla-get-layer itm) Lyrs))
    (vla-put-layer
      itm
      (if (vl-catch-all-error-p
     (vl-catch-all-apply
       'vla-item
       (list lyrsColl
      (setq lynm (strcat (cadr nme) (caddr nme)))
       )
     )
   )
 (progn (vla-add lyrsColl lynm)
        (vla-put-color
   (vla-item lyrsColl lynm)
   (atoi (cadr nme))
        )
        (if (= nil (tblsearch "LTYPE" (caddr nme)))
   (vla-add (vla-get-linetypes ltpotd (caddr nme)))
        )
        (vla-put-linetype
   (vla-item lyrsColl lynm)
   (caddr nme)
        )
        lynm
 )
 lynm
      )
    )
    (vla-put-linetype itm "ByLayer")
    (vla-put-color itm acByLayer)
  )
     (vla-delete ss)
   )
 )
 (princ)
)

 

Hope this Helps

 

If you need this to select all objects

change this

(ssget ":L" '((0 . "~VIEWPORT")))

to

(ssget "_X" '((0 . "~VIEWPORT")))

Edited by pBe
Include Linetype
Link to comment
Share on other sites

Hope you pBe do not mind if I posted my try with Vanilla codes . :)

 

(defun c:TesT (/ ss sset e l New)
 ;; Tharwat 07 Nov. 2011 ;;
 (if (setq ss (ssget "_:L"))
   (repeat (setq i (sslength ss))
     (setq sset (ssname ss (setq i (1- i))))
     (setq e (entget sset))
     (setq l (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))
     (if (not
           (tblsearch
             "LAYER"
             (setq
               New (strcat (itoa (cdr (assoc 62 l))) (cdr (assoc 6 l)))
             )
           )
         )
       (progn
         (entmakex (list '(0 . "LAYER")
                         '(100 . "AcDbSymbolTableRecord")
                         '(100 . "AcDbLayerTableRecord")
                         (cons 2 New)
                         (assoc 62 l)
                         (assoc 6 l)
                         (cons 70 0)
                   )
         )
         (entmod (subst (cons 8 New) (assoc 8 e) e))
       )
       (entmod (subst (cons 8 New) (assoc 8 e) e))
     )
   )
   (princ)
 )
 (princ)
)

Link to comment
Share on other sites

No worries Tharwat. I orignally wrote it with vanilla too, but now i always assumes the OP uses Annotative Entities.

 

(entmod (subst (cons 8 New) (assoc 8 e) e));

 

especially for Annotative Mtext the line above will messed up your text height

 

Cheers

 

BTW

Plus you may want to add to your routine, change the color and linetype to Bylayer as requested by the OP

Link to comment
Share on other sites

No worries Tharwat. I orignally wrote it with vanilla too, but now i always assumes the OP uses Annotative Entities.

 

(entmod (subst (cons 8 New) (assoc 8 e) e));

 

especially for Annotative Mtext the line above will messed up your text height

 

Cheers

 

BTW

Plus you may want to add to your routine, change the color and linetype to Bylayer as requested by the OP

Changing layer with entmod function won't affect on Annotative texts negatively , the same as entmod with text heights changing .

 

The routine does the job as expected and I think you did not try it , give it a try . :)

Link to comment
Share on other sites

Well Tharwat, I did try , Why do you think I suggested it?

 

Try changing the color of a couple of entities to 1 and linetype to Dashed, then run your routine

 

For Annotative MText, dont assume everybody is using the same units for their drawing

Link to comment
Share on other sites

Why do you think I suggested it?

 

Because most of experts read codes without giving them a try ( and undoubtedly you're one of them ) :)

 

Try changing the color of a couple of entities to 1 and linetype to Dashed, then run your routine

 

 

That's entirely correct and I did not think of it that way . You're right .

 

 

Best regards.

Link to comment
Share on other sites

Because most of experts read codes without giving them a try ( and undoubtedly you're one of them ) :)

Best regards.

 

Expert I'm not, really. I did looked at your code first, I saw you used entmod which prompted me to say what I did, all because I used that approach all the time, but with Annotative entities you can never be too sure.

 

That's entirely correct and I did not think of it that way . You're right .

Best regards.

 

Yes, thats what the OP wanted his code to do.

(COMMAND "CHPROP" esl "" "LA" LayName "C" "BYLAYER" "LType" "BYLAYER" "") ;

 

Cheers my friend.

 

 

 

 

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...