changed to lsp, xref question, filename test

This commit is contained in:
2019-09-30 23:49:39 +02:00
parent 135008b4c4
commit 9a8bdeb939
5 changed files with 280 additions and 197 deletions

View File

@@ -5,7 +5,7 @@ Clean dwg files before linking them to Revit
### Current features: ### Current features:
- change to model space - change to model space
- binds and detaches all xrefs (you can uncomment this line so it only detaches them) - bind (optional) and detach all xrefs
- remove all xlines from model space and from blocks - remove all xlines from model space and from blocks
- delete all points from modelspace - delete all points from modelspace
- move hatches to separate layers - move hatches to separate layers
@@ -14,6 +14,7 @@ Clean dwg files before linking them to Revit
- purge - purge
- audit - audit
- save as 2013 dwg - save as 2013 dwg
- save to desktop if filename is too long
### Planned features ### Planned features
@@ -21,3 +22,14 @@ Clean dwg files before linking them to Revit
- remove layouts - remove layouts
- replace heavy linestyles and hatches - replace heavy linestyles and hatches
- ask for units for automatic import - ask for units for automatic import
## Usage
- Download from [here](https://git.gyetpet.dynu.net/infeeeee/revitDwgImportCleaner/raw/branch/master/revitDwgImportCleaner.lsp) (rightclick, save page as)
- Drag the file to the opened Autocad drawing
- Select always load
- During execution it asks if you want to bind xrefs. Wrap this in an scr if you want to run this with Scriptpro
## License
MIT

235
revitDwgImportCleaner.lsp Normal file
View File

@@ -0,0 +1,235 @@
; ---------------------------------------------------------------------------- ;
; RevitDwgImportCleaner.lsp ;
; ---------------------------------------------------------------------------- ;
; Use this script to clean bad quality dwgs before importing tham to Revit.
; Just drag the script to the autocad window.
; The script automatically starts after loading, no command needed.
; Version 1.3
; Created by Peter Gyetvai
; gyetpet@mailbox.org
; git repo: https://git.gyetpet.dynu.net/infeeeee/revitDwgImportCleaner
; ---------------------------------------------------------------------------- ;
; FUNCTIONS ;
; ---------------------------------------------------------------------------- ;
; ------------------------ XREFS: bind and detach all ------------------------ ;
(defun bindAndDetachXrefs (/ really blk)
(graphscr)
(initget 1 "Yes No")
(setq really (getkword "Bind xrefs? [Yes/No]"))
(if
(= really "YES")
(foreach x
(mapcar 'cadr (ssnamex (ssget "_X" '((0 . "INSERT") (410 . "MODEL")))))
(setq blk (cdr (assoc 2 (entget x))))
(if (assoc 1 (tblsearch "block" blk))
(progn
(command "_.-xref" "_bind" blk)
(command "_.-xref" "_detach" blk)
)
)
)
)
)
; ----------- deleteAllXlines.lsp: deletes all xlines in modelspace ---------- ;
(defun dax (/ ss)
(graphscr)
(setq ss (ssget "_A" '((0 . "XLINE"))))
(if ss
(command "._erase" ss "")
)
(princ)
)
; ------------- deleteAllPoints: deletes all points in modelspace ------------ ;
(defun dap (/ ss)
(graphscr)
(setq ss (ssget "_A" '((0 . "POINT"))))
(if ss
(command "._erase" ss "")
)
(princ)
)
; ------------------- rxl.lsp: removes xlines from blocks: ------------------- ;
(defun rxl (/ b d l lo nl x)
;; RJP - 04.30.2018
;; Deletes xlines within block definitions
(vlax-for a (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(if (= 0 (vlax-get a 'islayout))
(vlax-for b a
(if (and (vlax-write-enabled-p b) (= "AcDbXline" (vla-get-objectname b)))
(vl-catch-all-apply 'vla-delete (list b))
)
)
)
)
(princ)
)(vl-load-com)
; ----------------- sepHatch.lsp: Move hatches to new layers ----------------- ;
(defun sephatch (/ ss i il imax currElem layerName newLayerName layerSettings newLayerSettings newLayer newElem)
(graphscr)
(setq ss (ssget "_A" '((0 . "HATCH"))))
(setq il (sslength ss));length of selection
(setq i 0);counter to zero
(setq imax 1);while variable
(while imax
(setq currElem (entget (ssname ss i) ))
(setq layerName (cdr (assoc 8 currElem)))
(setq newLayerName (strcat layerName "-hatch"))
(command "._-layer" "_M" newLayerName "")
(setq layerSettings (entget (tblobjname "LAYER" layerName)))
(setq newLayerSettings (entget (tblobjname "LAYER" newLayerName)))
(setq newLayer (subst (cons 62 (cdr (assoc 62 layerSettings))) (assoc 62 newLayerSettings) newLayerSettings))
(setq newLayer (subst (cons 70 (cdr (assoc 70 layerSettings))) (assoc 70 newLayer) newLayer))
(entmod newLayer)
(setq newElem(subst (cons 8 newLayerName) (assoc 8 currElem) currElem))
(entmod newElem)
(setq i (1+ i));increments i
(if (= i il) (setq imax nil));finish function if i equals il
)
(princ)
)
; ------------------------------- AttDef2Text: ------------------------------- ;
; Attribute definitions to txt by Lee Mac.
; Source: https://www.cadtutor.net/forum/topic/21700-convert-attribute-definition-to-text/
(defun cAttDef2Text ( / ss )
;; © Lee Mac ~ 01.06.10
(vl-load-com)
(if (setq ss (ssget "_A" '((0 . "ATTDEF"))))
(
(lambda ( i / e o )
(while (setq e (ssname ss (setq i (1+ i))))
(if
(
(if (and (vlax-property-available-p
(setq o (vlax-ename->vla-object e)) 'MTextAttribute)
(eq :vlax-true (vla-get-MTextAttribute o)))
MAttDef2MText AttDef2Text
)
(entget e)
)
(entdel e)
)
)
)
-1
)
)
(princ)
)
(defun AttDef2Text ( eLst / dx74 dx2 )
;; © Lee Mac ~ 01.06.10
(setq dx74 (cdr (assoc 74 eLst)) dx2 (cdr (assoc 2 eLst)))
(entmake
(append '( (0 . "TEXT") ) (RemovePairs '(0 100 1 2 3 73 74 70 280) eLst)
(list
(cons 73 dx74)
(cons 1 dx2)
)
)
)
)
(defun MAttDef2MText ( eLst )
;; © Lee Mac ~ 01.06.10
(entmake
(append '( (0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText") )
(RemoveFirstPairs '(40 50 41 7 71 72 71 72 73 10 11 11 210)
(RemovePairs '(-1 102 330 360 5 0 100 101 1 2 3 42 43 51 74 70 280) eLst)
)
(list (cons 1 (cdr (assoc 2 eLst))))
)
)
)
(defun RemoveFirstPairs ( pairs lst )
;; © Lee Mac
(defun foo ( pair lst )
(if lst
(if (eq pair (caar lst))
(cdr lst)
(cons (car lst) (foo pair (cdr lst)))
)
)
)
(foreach pair pairs
(setq lst (foo pair lst))
)
lst
)
(defun RemovePairs ( pairs lst )
;; © Lee Mac
(vl-remove-if
(function
(lambda ( pair )
(vl-position (car pair) pairs)
)
)
lst
)
)
; -------------------------- checkedExportToAutocad -------------------------- ;
;if the file length is too long, export to desktop
(defun checkedExportToAutocad (/ prefix basefilename fn1 fn2 fullength filename savepath)
(vl-load-com)
(setq prefix (getvar "dwgprefix"))
(setq basefilename (getvar "dwgname"))
(setq fn1 (strlen (getvar "dwgprefix")))
(setq fn2 (strlen (getvar "dwgname")))
(setq fullength (+ fn1 fn2 5 8))
(if (> fullength 255)
(progn
(setq prefix (strcat (getenv "USERPROFILE") "\\Desktop"))
(setq filename(vl-string-right-trim ".dwg" basefilename))
(setq savepath (strcat prefix "\\ACAD-" filename "_cleaned.dwg" ))
(command "._-AECEXPORTTOAUTOCAD" "f" "2013" "" savepath)
(print "Too long filename, saved to desktop!")
)
(command "._-AECEXPORTTOAUTOCAD" "f" "2013" "s" "_cleaned" "")
)
)
; ---------------------------------------------------------------------------- ;
; CODE ;
; ---------------------------------------------------------------------------- ;
;; Set view
(command "._MODEL")
(command "._ZOOM" "e")
(command "._REGENALL")
;; Xrefs
(bindAndDetachXrefs)
(command "._-xref" "d" "*")
;; Xlines
(dax)
(rxl)
;;Points
(dap)
;; Hatches
(sephatch)
;; Attdef to txt
(cAttDef2Text)
;; Variables
(setvar "PROXYGRAPHICS" 1)
;; Cleanup and fix
(command "._-PURGE" "a" "*" "n")
(command "._AUDIT" "y")
(command "._REGENALL")
;; Export
(checkedExportToAutocad)

View File

@@ -1,186 +0,0 @@
;version 1.2
;Run this script before importing dwg-s to Revit
;Created by Peter Gyetvai - gyetpet@gmail.com
;
._MODEL
;------------------------------------------------------------
;XREFS: bind and detach all
(defun C:bindAndDetachXrefs (/ blk)
(graphscr)
(foreach x
(mapcar 'cadr (ssnamex (ssget "_X" '((0 . "INSERT") (410 . "MODEL")))))
(setq blk (cdr (assoc 2 (entget x))))
(if (assoc 1 (tblsearch "block" blk))
(progn
(command "_.-xref" "_bind" blk)
(command "_.-xref" "_detach" blk)
)
)
)
)
;If you don't want to bind just detach uncomment the following line:
bindAndDetachXrefs
;------------------------------------------------------------
;Detach all xrefs.
._-xref d *
;------------------------------------------------------------
;deleteAllXlines.lsp: deletes all xlines in modelspace
(defun C:dax (/ ss)
(graphscr)
(setq ss (ssget "_A" '((0 . "XLINE"))))
(if ss
(command "._erase" ss "")
)
(princ)
)
dax
;------------------------------------------------------------
;deleteAllPoints: deletes all points in modelspace
(defun C:dap (/ ss)
(graphscr)
(setq ss (ssget "_A" '((0 . "POINT"))))
(if ss
(command "._erase" ss "")
)
(princ)
)
dap
;------------------------------------------------------------
;rxl.lsp: removes xlines from blocks:
(defun c:rxl (/ b d l lo nl x)
;; RJP - 04.30.2018
;; Deletes xlines within block definitions
(vlax-for a (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(if (= 0 (vlax-get a 'islayout))
(vlax-for b a
(if (and (vlax-write-enabled-p b) (= "AcDbXline" (vla-get-objectname b)))
(vl-catch-all-apply 'vla-delete (list b))
)
)
)
)
(princ)
)(vl-load-com)
rxl
;------------------------------------------------------------
;sepHatch.lsp: Move hatches to new layers
(defun C:sephatch (/ ss i il imax currElem layerName newLayerName layerSettings newLayerSettings newLayer newElem)
(graphscr)
(setq ss (ssget "_A" '((0 . "HATCH"))))
(setq il (sslength ss));length of selection
(setq i 0);counter to zero
(setq imax 1);while variable
(while imax
(setq currElem (entget (ssname ss i) ))
(setq layerName (cdr (assoc 8 currElem)))
(setq newLayerName (strcat layerName "-hatch"))
(command "._-layer" "_M" newLayerName "")
(setq layerSettings (entget (tblobjname "LAYER" layerName)))
(setq newLayerSettings (entget (tblobjname "LAYER" newLayerName)))
(setq newLayer (subst (cons 62 (cdr (assoc 62 layerSettings))) (assoc 62 newLayerSettings) newLayerSettings))
(setq newLayer (subst (cons 70 (cdr (assoc 70 layerSettings))) (assoc 70 newLayer) newLayer))
(entmod newLayer)
(setq newElem(subst (cons 8 newLayerName) (assoc 8 currElem) currElem))
(entmod newElem)
(setq i (1+ i));increments i
(if (= i il) (setq imax nil));finish function if i equals il
)
(princ)
)
sephatch
;------------------------------------------------------------
;AttDef2Text: Attribute definitions to txt by Lee Mac. source: https://www.cadtutor.net/forum/topic/21700-convert-attribute-definition-to-text/
(defun c:AttDef2Text ( / ss )
;; © Lee Mac ~ 01.06.10
(vl-load-com)
(if (setq ss (ssget "_A" '((0 . "ATTDEF"))))
(
(lambda ( i / e o )
(while (setq e (ssname ss (setq i (1+ i))))
(if
(
(if (and (vlax-property-available-p
(setq o (vlax-ename->vla-object e)) 'MTextAttribute)
(eq :vlax-true (vla-get-MTextAttribute o)))
MAttDef2MText AttDef2Text
)
(entget e)
)
(entdel e)
)
)
)
-1
)
)
(princ)
)
(defun AttDef2Text ( eLst / dx74 dx2 )
;; © Lee Mac ~ 01.06.10
(setq dx74 (cdr (assoc 74 eLst)) dx2 (cdr (assoc 2 eLst)))
(entmake
(append '( (0 . "TEXT") ) (RemovePairs '(0 100 1 2 3 73 74 70 280) eLst)
(list
(cons 73 dx74)
(cons 1 dx2)
)
)
)
)
(defun MAttDef2MText ( eLst )
;; © Lee Mac ~ 01.06.10
(entmake
(append '( (0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText") )
(RemoveFirstPairs '(40 50 41 7 71 72 71 72 73 10 11 11 210)
(RemovePairs '(-1 102 330 360 5 0 100 101 1 2 3 42 43 51 74 70 280) eLst)
)
(list (cons 1 (cdr (assoc 2 eLst))))
)
)
)
(defun RemoveFirstPairs ( pairs lst )
;; © Lee Mac
(defun foo ( pair lst )
(if lst
(if (eq pair (caar lst))
(cdr lst)
(cons (car lst) (foo pair (cdr lst)))
)
)
)
(foreach pair pairs
(setq lst (foo pair lst))
)
lst
)
(defun RemovePairs ( pairs lst )
;; © Lee Mac
(vl-remove-if
(function
(lambda ( pair )
(vl-position (car pair) pairs)
)
)
lst
)
)
AttDef2Text
;------------------------------------------------------------
PROXYGRAPHICS
1
._-PURGE
a
*
n
._ZOOM
e
._REGENALL
._AUDIT
y
._-AECEXPORTTOAUTOCAD
f
2013
s
_cleaned

View File

@@ -5,9 +5,12 @@
;; Created by Peter Gyetvai ;; Created by Peter Gyetvai
;; gyetpet@mailbox.org ;; gyetpet@mailbox.org
(defun C:bindAndDetachXrefs (/ blk) (defun C:bindAndDetachXrefs (/ really blk)
(graphscr) (graphscr)
(initget 1 "Yes No")
(setq really (getkword "Bind xrefs? [Yes/No]"))
(if
(= really "YES")
(foreach x (foreach x
(mapcar 'cadr (ssnamex (ssget "_X" '((0 . "INSERT") (410 . "MODEL"))))) (mapcar 'cadr (ssnamex (ssget "_X" '((0 . "INSERT") (410 . "MODEL")))))
(setq blk (cdr (assoc 2 (entget x)))) (setq blk (cdr (assoc 2 (entget x))))
@@ -19,3 +22,4 @@
) )
) )
) )
)

View File

@@ -0,0 +1,18 @@
(defun c:checkedExportToAutocad (/ prefix basefilename fn1 fn2 fullength filename savepath)
(vl-load-com)
(setq prefix (getvar "dwgprefix"))
(setq basefilename (getvar "dwgname"))
(setq fn1 (strlen (getvar "dwgprefix")))
(setq fn2 (strlen (getvar "dwgname")))
(setq fullength (+ fn1 fn2 5 8))
(if (> fullength 255)
(progn
(setq prefix (strcat (getenv "USERPROFILE") "\\Desktop"))
(setq filename(vl-string-right-trim ".dwg" basefilename))
(setq savepath (strcat prefix "\\ACAD-" filename "_cleaned.dwg" ))
(command "._-AECEXPORTTOAUTOCAD" "f" "2013" "" savepath)
(print "Too long filename, saved to desktop!")
)
(command "._-AECEXPORTTOAUTOCAD" "f" "2013" "s" "_cleaned" "")
)
)