Jump to content
mistri2000

Lisp routine to clean up architects layout

Recommended Posts

mistri2000

Hi need help with a lisp routine to clean up architects drawings with the following.

Unlock,Unfreeze & turn on all layers

Burst

Change all layers to bylayer

Change all hatch’s to colour 254 and send to back

Change all line weights to 0.18

Change all to Colour 8

Overkill

Purge

Share this post


Link to post
Share on other sites
BIGAL

A couple of questions

 

The layers set to bylayer or all objects bylayer also ? If all by layer then set the line weight as part of change layer settings same as colour.

 

(defun allbylayer ( / x obj ssall)
(setq ssall (ssget "x"))
(repeat (setq x  (sslength ssall))
(setq obj (vlax-ename->vla-object (ssname ssall (setq x (- x 1)))))
(vlax-put-property obj "Linetype" "Bylayer") 
(vlax-put-property obj "Lineweight" " -1")
(vlax-put-property obj "Color" acbylayer)
)
)
(allbylayer)
(Alert "All objects now by layer")

 

; open database
(setq  doc (vla-get-activedocument  (vlax-get-acad-object))) 
(setq lays (vla-get-Layers doc))
(vlax-for lay lays
(vla-put-color lay 
(vla-put-lineweight lay 18) ; note 18 for metric =0.18 not tested on feet dwg must match a known size.
)

 

Burst has an alias when used with lisp will find. But this works

 

(while (setq ss (ssget "X" ))
(sssetfirst nil ss)
(C:Burst)
)

 

Purge use

(command "-purge" "all" "*" "n")

 

Overkill help anyone

Share this post


Link to post
Share on other sites
steven-g

I could do with a LISP that would work on the Architect's before they start on the drawings :shock:

Share this post


Link to post
Share on other sites
mistri2000

Thanks BIGAL will give it a go & let you know how it goes!

Share this post


Link to post
Share on other sites
mistri2000

BIGAL yes all layers changed to bylayer & all to colour 8, also any joy with the hatch to 254 & set to back?

Share this post


Link to post
Share on other sites
mistri2000

Thanks BIGAL will give it a go & let you know how it goes!

 

BIGAL yes all layers changed to bylayer & all to colour 8, also any joy with the hatch to 254 & set to back?

Share this post


Link to post
Share on other sites
ronjonp
THIS could be modified to do what you want.

Share this post


Link to post
Share on other sites
mistri2000

Thanks could you send a lsp for me to try?

Share this post


Link to post
Share on other sites
ronjonp
THIS could be modified to do what you want.

 

Here's a start:

Unlock,Unfreeze & turn on all layers

Burst

Change all layers to bylayer Assume this is all objects to bylayer

Change all hatch’s to colour 254 and send to back

Change all line weights to 0.18

Change all to Colour 8

Overkill

Purge

 

(defun c:drawingtobylayer
      ;;-----------------------------------------------------------------
      ;;
      ;;  Copyright © 2004 Michael Puckett. All Rights Reserved
      ;;
      ;;-----------------------------------------------------------------
      ;;
      ;;  Forces the entire drawing to "ByLayer" (even xrefs for
      ;;  the lifetime of the session or until an xref reload
      ;;  occurs).
      ;;
      ;;  Forces block definition child entities to layer "0".
      ;;
      ;;  Existing attributes are forced to the same layer the
      ;;  parent block reside on.
      ;;
      ;;  Nominally tested, let me know if you find anything wonky.
      ;;
      ;;  * Use at your own risk. Please test on a dummy dwg *
      ;;
      ;;-----------------------------------------------------------------
      (/ _unlockalllayers _locklayers _objecttolayerzero _objecttobylayer _documenttobylayer _main)
 ;; (idt_draworder (idt_ss->vla-list (ssget)) 'movetobottom)
 (defun _unlockalllayers (document / result)
   (vlax-for layer (vlax-get-property document 'layers)
     (cond ((eq :vlax-true (vlax-get-property layer 'lock))
     (vlax-put-property layer 'lock :vlax-false)
     (setq result (cons layer result))
    )
     )
     ;; RJP added: Change all layers to color 8, linewight to 18mm, thaw and turn on
     (foreach property	'((color .  (lineweight . 18) (freeze . 0) (layeron . -1))
(vl-catch-all-apply 'vlax-put (list layer (car property) (cdr property)))
     )
   )
   result
 )
 (vlax-ename->vla-object (tblobjname "layer" "0"))
 (defun _locklayers (layers) (foreach layer layers (vlax-put-property layer 'lock :vlax-true)))
 ;; (defun _objecttolayerzero (object) (vlax-put-property object 'layer "0"))
 (defun _objecttobylayer (obj / layer)
   ;; RJP added lineweight and transparency
   (foreach property '((color . 256)
		(linetype . "ByLayer")
		(lineweight . "ByLayer")
		(transparency . "ByLayer")
	       )
     (vl-catch-all-apply 'vlax-put (list obj (car property) (cdr property)))
   )
   (cond ((and	(eq "AcDbBlockReference" (vlax-get obj 'objectname))
	(eq :vlax-true (vlax-get-property obj 'hasattributes))
   )
   (setq layer (vlax-get-property obj 'layer))
   (foreach child (vlax-invoke obj 'getattributes)
     (_objecttobylayer child)
     (vlax-put-property child 'layer layer)
   )
  )
  ;; RJP added hatch to color 254
  ((eq "AcDbHatch" (vlax-get obj 'objectname))
   (vl-catch-all-apply 'vla-put-color (list obj 254))
  )
   )
 )
 (defun _documenttobylayer (document)
   (vlax-for block (vlax-get-property document 'blocks)
     (if (eq :vlax-true (vlax-get-property block 'islayout))
(vlax-for object block (_objecttobylayer object))
(vlax-for object block (_objecttobylayer object))
     )
   )
 )
 (defun _main (/ document lockedlayers)
   (setq lockedlayers
   (_unlockalllayers
     (setq document (vlax-get-property (vlax-get-acad-object) 'activedocument))
   )
   )
   (_documenttobylayer document)
   ;; RJP leave layers unlocked
   ;; (_locklayers lockedlayers)
   (princ)
 )
 (_main)
)

Share this post


Link to post
Share on other sites
mistri2000

Thanks Ronjonp will give this a try! :)

Share this post


Link to post
Share on other sites
mistri2000

Many thanks that worked great just need to try and add the burst, overkill & purge in there! if anyone can help with adding this ?

Share this post


Link to post
Share on other sites
mistri2000

Many Thanks this worked well, just need to get the burst, overkill & purge in there! let hope someone can help! :thumbsup:

Share this post


Link to post
Share on other sites
mistri2000

thanks BIGAL tried these and had issues making them in one lisp routine to work. :?

Share this post


Link to post
Share on other sites
BIGAL

In a crude way just add the Burst code to the start of Ronjonp code then add the purge at the end.

 

A bettter way is to make it a sequence

 

(defun c:cleanmy ()

(if (not _objecttobylayer)(load "drawingbylayer")) ; loads ronjonp code 

(while (setq ss (ssget "X" ))
(sssetfirst nil ss)
(C:Burst)
)

(c:drawingtobylayer) ; runs ronjonp code

; overkill goes here

(command "-purge" "all" "*" "n")
) 

Share this post


Link to post
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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

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