;version 1.2
;Run this script before importing dwg-s to Revit
;Created by Peter Gyetvai - gyetpet@gmail.com
;
._MODEL
;------------------------------------------------------------
;XREF manegement is completely disabled until I fix it
;._-xref
;r
;*
;._-xref
;b
;*
;------------------------------------------------------------
;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
;------------------------------------------------------------
;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
;------------------------------------------------------------
._-PURGE
a
*
n
._ZOOM
e
._REGENALL
._AUDIT
y
._-AECEXPORTTOAUTOCAD
f
2013
s
_cleaned