Repair Lisp to create superimpose acad

[karfung]

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

 

Hi Bro,

The LISP code above is awesome, and it is working. But, I encountered an error below and as per the attached drawing 1 with mp4 video (in link) and added it 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 the completed Lisp code. 

 

Thanks. 

 

https://drive.google.com/file/d/15VNesdJ3uHtPbUlrNbCsaP0yMzY3e2Po/view?usp=sharing

 

 

Drawing1.dwg

Edited 5 hours ago by SLW210
Added Code Tags!!

[SLW210]

In the future, please place your code in code tags. (<> in the editor toolbar)

[SLW210]

Your video did not work for me.

 

Your LISP ran just fine on my computer.

[pkenewell]

Does the LISP file load the Visual LISP ActiveX functions with (vl-load-com)? I don't see it in the code.

[rlx]

maybe first do an audit on this drawing

[devitg]

6 hours ago, karfung said:

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

 

Hi Bro,

The LISP code above is awesome, and it is working. But, I encountered an error below and as per the attached drawing 1 with mp4 video (in link) and added it 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 the completed Lisp code. 

 

Thanks. 

 

https://drive.google.com/file/d/15VNesdJ3uHtPbUlrNbCsaP0yMzY3e2Po/view?usp=sharing

 

 

Drawing1.dwg 4.15 MB · 4 downloads

@karfung it seem to be you need to make a new.dwg , if so, you can use WRITEBLOCK acad command . 

 

 

[devitg]

@karfung see the new dwg 

new block.dwg

[devitg]

4 hours ago, SLW210 said:

In the future, please place your code in code tags. (<> in the editor toolbar)

@SLW210 how to select all the code at code tags , like a short key ctrl+a or whatever 

Edited 34 minutes ago by devitg
add text