162 lines
4.2 KiB
Plaintext
162 lines
4.2 KiB
Plaintext
;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
|
|
|
|
|