Request Lisp to create superimpose acad

[karfung]

Hi Team, 

I wish to create a lisp with condition as follows;

1). Copy the object with specific point. 

2). Automatically paste it in new ACAD file in position 0,0,0. Change all layers in the object in colour 21 included layer in block and dim. 

3). Save the file in desktop. 

Kindly advise lisp code.

Thanks. 

[Kent1Cooper]

AutoLisp cannot start in one drawing and continue in another.

One approach that AutoLisp could do that I think would achieve what you want:

Set an UNDO Mark.

Change the Layer/Color/etc. properties of the object(s) as desired.

MOVE the object(s) from your "specific point" to 0,0.

WBLOCK the object(s) out to a separate drawing on the desktop, using 0,0 for the base point.

UNDO Back to restore everything in the current drawing to what it was before starting [position and properties of the object(s)].

[komondormrex · Accepted solution]

@karfung 

hey,

check the following fairly simple code. no error catching thou.

(defun c:new_desktop_file_copy (/ acad_dbx object_list zero_point)
  (defun make_color_21 (/ layers)
    (setq layers (vla-get-layers acad_dbx))
    (vlax-map-collection (vla-get-blocks acad_dbx)
      '(lambda (block) (vlax-map-collection block '(lambda (object) (vla-put-color object 256)
						     		    (if (/= 21 (vla-get-color (setq layer (vla-item layers (vla-get-layer object)))))
								      (vla-put-color layer 21)
								    )
						   )
		       )
       )
    )
  )
  (setq acad_dbx (vla-getinterfaceobject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." (substr (getvar 'acadver) 1 2))))
  (prompt "\nPick objects to copy to a new file on the desktop...")
  (setq object_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget))))))
  (setq zero_point (getpoint "\nPick zero point for the copied entities: "))
  (foreach copied_object 
	  (setq odbx_objects_list
		  (vlax-invoke (vla-get-database (vla-get-activedocument (vlax-get-acad-object)))
		  			  'copyobjects
		  			   object_list
		  			   (vla-get-modelspace acad_dbx)
		  )
	  )
    	  (vla-move copied_object (vlax-3d-point zero_point) (vlax-3d-point 0 0 0))
  )
  (make_color_21)
  (vla-saveas acad_dbx (princ (strcat (getenv "userprofile") "\\Desktop\\" (getstring "\nEnter file name: ") ".dwg")))
  (vlax-release-object acad_dbx)
  (princ)
)

oops, i did it again.

[karfung]

Thanks Bro. This LISP code is really awesome. 

[karfung]

Hi Bro,

The LISP code is awesome, and it is working. But, I encountered an error as per the attached drawing 1 with mp4 video and added on as follows,

1). Please set the unit to be "mm" in the created file. 

2). Please zoom extend for the created file. 

fyi, I did changed the LISP code to "CP"

Kindly advise and revert with completed lisp code. 

Thanks. 

[karfung]

Kindly advise this. Thanks. 

[karfung]

Kindly advise this.