Added moveOrigin and deleteLayouts

This commit is contained in:
2021-02-13 00:58:51 +01:00
parent 3f3e367377
commit 753c0ee058
4 changed files with 146 additions and 4 deletions

View File

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

View File

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