Added moveOrigin and deleteLayouts

README.md

@@ -2,14 +2,16 @@
 
 Clean dwg files before linking them to Revit
 
-### Current features:
+### Features:
 
 - change to model space
-- bind (optional) and detach all xrefs
+- bind and detach all xrefs (optional)
 - remove all xlines from model space and from blocks
 - delete all points from modelspace
 - move hatches to separate layers
 - attribute definitions not in block to txt because they are not showing up in Revit
+- delete all layouts (optional)
+- accept current UCS as origin or move origin
 - change and verify units for automatic import
 - PROXYGRAPHICS=1 (one less annoying dialog)
 - purge
@@ -19,8 +21,6 @@ Clean dwg files before linking them to Revit
 
 ### Planned features
 
-- move closer to origin
-- remove layouts
 - replace heavy linestyles and hatches
 
 ## Usage

revitDwgImportCleaner.lsp

@@ -271,6 +271,75 @@
     (princ)
 )
 
+; -------------------------------- moveOrigin -------------------------------- ;
+
+(defun moveOrigin (/ move wcs setCurrUcs newOrigin)
+    (vl-load-com)
+    (graphscr)
+
+    (initget 1 "Yes No")
+    (setq move (getkword "Move origin? [Yes/No]"))
+    (if 
+        (= move "Yes")
+        (progn
+            (setq wcs (getvar "worlducs"))
+            (if
+                (= wcs 0)
+                (progn
+                    ;; it's not WCS
+                    (initget 1 "UCS Pick")
+                    (setq setCurrUcs (getkword "Set current UCS or pick point [UCS/Pick]"))
+                    (if 
+                        (= setCurrUcs "UCS")
+                        (progn
+                            (setq newOrigin (trans '(0.0 0.0 0.0) 1 0))
+                            (command "._UCS" "W")
+                            (moveDrawing newOrigin)
+                        )
+                        (progn
+                            ;; Pick point selected
+                            (command "._UCS" "W")
+                            (pickPoint)       
+                        )
+                    )
+                )
+                ;;it's wcs:
+                (pickPoint)
+            )
+        )
+    )
+)
+
+(defun pickPoint ()
+    (setq newOrigin (getpoint "\nPick new origin"))
+    ;; (print newOrigin)
+    (moveDrawing newOrigin)
+)
+
+(defun moveDrawing (point / ssX coords)
+    (setq ssX (ssget "x"))
+    (setq coords (strcat (rtos (car point) 2) "," (rtos (cadr point) 2)))
+    
+    (command "move" ssX "" coords "0,0")
+)
+
+; ------------------------------- deleteLayouts ------------------------------ ;
+(defun deleteLayouts ()
+    (vl-load-com)
+    (graphscr)
+
+    (initget 1 "Yes No")
+    (setq really (getkword "Delete all layouts? [Yes/No]"))
+    (if 
+        (= really "Yes")
+        (vlax-for l (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
+            (if (/= (vla-get-name l) "Model")
+                (vla-delete l)
+            )
+        )        
+    )
+)
+
 ; -------------------------- checkedExportToAutocad -------------------------- ;
 ;if the file length is too long, export to desktop
 (defun checkedExportToAutocad (/ prefix basefilename fn1 fn2 fullength filename savepath)
@@ -317,6 +386,13 @@
 ;; Attdef to txt
 (cAttDef2Text)
 
+;; deleteLayouts
+(deleteLayouts)
+
+;; moveOrigin
+(moveOrigin)
+(command "._ZOOM" "e")
+
 ;; Units
 (unitcheck)
 

source scripts/deleteLayouts.lsp

@@ -0,0 +1,15 @@
+(defun C:deleteLayouts ()
+    (vl-load-com)
+    (graphscr)
+
+    (initget 1 "Yes No")
+    (setq really (getkword "Delete all layouts? [Yes/No]"))
+    (if 
+        (= really "Yes")
+        (vlax-for l (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
+            (if (/= (vla-get-name l) "Model")
+                (vla-delete l)
+            )
+        )        
+    )
+)

source scripts/moveOrigin.lsp

@@ -0,0 +1,51 @@
+(defun C:moveOrigin (/ move wcs setCurrUcs newOrigin)
+    (vl-load-com)
+    (graphscr)
+
+    (initget 1 "Yes No")
+    (setq move (getkword "Move origin? [Yes/No]"))
+    (if 
+        (= move "Yes")
+        (progn
+            (setq wcs (getvar "worlducs"))
+            (if
+                (= wcs 0)
+                (progn
+                    ;; it's not WCS
+                    (initget 1 "UCS Pick")
+                    (setq setCurrUcs (getkword "Set current UCS or pick point [UCS/Pick]"))
+                    (if 
+                        (= setCurrUcs "UCS")
+                        (progn
+                            (setq newOrigin (trans '(0.0 0.0 0.0) 1 0))
+                            (command "._UCS" "W")
+                            (moveDrawing newOrigin)
+                        )
+                        (progn
+                            ;; Pick point selected
+                            (command "._UCS" "W")
+                            (pickPoint)
+                                
+                        )
+                        
+                    )
+                )
+                ;;it's wcs:
+                (pickPoint)
+            )
+        )
+    )
+)
+
+(defun pickPoint ()
+    (setq newOrigin (getpoint "\nPick new origin"))
+    ;; (print newOrigin)
+    (moveDrawing newOrigin)
+)
+
+(defun moveDrawing (point / ssX coords)
+    (setq ssX (ssget "x"))
+    (setq coords (strcat (rtos (car point) 2) "," (rtos (cadr point) 2)))
+    
+    (command "move" ssX "" coords "0,0")
+)