Added attdef2text

README.md

@@ -7,6 +7,7 @@ Clean dwg files before linking them to Revit
 - change to model space
 - remove all xlines from model space and from blocks
 - move hatches to separate layers
+- attribute definitions not in block to txt because they are not showing up in Revit
 - purge
 - audit
 - save as 2013 dwg
@@ -17,3 +18,4 @@ Clean dwg files before linking them to Revit
 - remove layouts
 - do something with xrefs(bind or purge)
 - replace heavy linestyles and hatches
+- ask for units for automatic import

revitDwgImportCleaner.scr

@@ -66,6 +66,83 @@ rxl
 )
 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
 *

source scripts/attdef2text.lsp

@@ -0,0 +1,80 @@
+;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
+ )
+)