Jump to content

Lisp routine to clean up architects layout


mistri2000

Recommended Posts

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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")
) 

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