From 303cc62b057db4e0710f62a0779c23e7276ec258 Mon Sep 17 00:00:00 2001 From: infeeeee Date: Tue, 30 Apr 2019 15:37:26 +0200 Subject: [PATCH] Added attdef2text --- README.md | 2 + revitDwgImportCleaner.scr | 77 ++++++++++++++++++++++++++++++++ source scripts/attdef2text.lsp | 80 ++++++++++++++++++++++++++++++++++ 3 files changed, 159 insertions(+) create mode 100644 source scripts/attdef2text.lsp diff --git a/README.md b/README.md index b8c730a..9a86789 100644 --- a/README.md +++ b/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 \ No newline at end of file diff --git a/revitDwgImportCleaner.scr b/revitDwgImportCleaner.scr index 1cbc28a..894ee53 100644 --- a/revitDwgImportCleaner.scr +++ b/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 * diff --git a/source scripts/attdef2text.lsp b/source scripts/attdef2text.lsp new file mode 100644 index 0000000..69bca47 --- /dev/null +++ b/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 + ) +) \ No newline at end of file