;; --------------------------------------------------------------------------------------------------
;; 	RVTaDWG.lsp Corrige defectos de exportación a DWG desde Revit
;; --------------------------------------------------------------------------------------------------
;; Escrito por: Alberto Montealegre Beach
;;              MONTEALEGRE BEACH ARQUITECTOS
;;              Revit-MBA (http://revit-mba.blogspot.com)
;; Creado el : 27/12/2008
;;;
;;; Esta rutina LISP debe correrse sobre un archivo DWG generado por REVIT 2009 tecleando "RVTaDWG". 
;;; Funciones:
;;; Crea un estilo de texto llamado "DIM000" para acotado,
;;; Reconvierte los estilos de acotado generados por Revit para que su aspecto sea idéntico y equivalente al 
;;; original de Revit,
;;; Pone los Viewports en estado Freeze,
;;; Quita la máscara de los textos (Background mask) para que no oculten el dibujo,
;;; Pone layer de viewports en modo No-Ploteo,
;;; Carga un archivo de layouts estándar de configuración de página,
;;; Ensancha ligeramente los viewports para que no recorten el dibujo (ejes), texto, etc..
;;;
;;; Esta rutina incorpora y utiliza fragmentos de otras de acceso libre en Internet.

(vl-load-com)
(defun c:RVTaDWG ()


;; --------------------------------------------------------------------------------------------------
;; 	ELIMINAR ENMASCARADO DE TEXTO (MTEXT Background Mask)
;; --------------------------------------------------------------------------------------------------
;; Fragmentos de rutina lisp escrita por: Lee Ambrosius
;; Created on: 4/7/2004


;(defun c:MTextMASK ( / kWordBackgroundMaskCurrent dOffsetCurrent ssMtext dxf90 dxf63 dxf45 dxf441)

(setq kWordBackgroundMask "None")
(setq maskClr 0 dOffset 1.0)

  (if (/= maskClr nil)
    (progn
      (if (/= kWordBackgroundMask "None")
        (progn
          (setq dOffsetCurrent dOffset)

          (if (= dOffsetCurrent nil)
            (setq dOffset 1.0 dOffsetCurrent 1.0)
            (setq dOffsetCurrent dOffset)
          )

          (setq dOffset (getreal (strcat "\nSpecify border offset factor: <" (rtos dOffsetCurrent 2 3) ">: ")))
    
          (if (= dOffset nil)
            (setq dOffset dOffsetCurrent)
          )

          (if (> dOffset 5)(setq dOffset nil))
          (if (< dOffset 1)(setq dOffset nil))

          (while (= dOffset nil)
            (setq dOffset (getreal (strcat "\nSpecify border offset factor: <" (rtos dOffsetCurrent 2 3) ">: ")))
 
            (if (> dOffset 5)(setq dOffset nil))
            (if (< dOffset 1)(setq dOffset nil))
          )
        )
        (if (= dOffset nil)
          (setq dOffset 1.0)
        )
      )

      (if (setq ssMtext (ssget "all" (list (cons 0 "MTEXT"))))
        (progn
          (cond ((= kWordBackgroundMask "None")
                    (setq mask_list (list (cons 90 2)(cons 63 0)(cons 45 dOffset)(cons 441 0))
                          dxf90 2
                          dxf63 nil
                          dxf45 nil
                          dxf441 nil
                    )
                )
                ((and (= kWordBackgroundMask "Color")(/= (assoc 420 maskClr) nil))
                    (setq mask_list (list (cons 90 1)(cons 63 1)(cons 421 (cdr (assoc 420 maskClr)))(cons 45 dOffset)(cons 441 (cdr (assoc 420 maskClr))))
                          dxf90 1
                          dxf63 2
                          dxf45 dOffset
                          dxf441 (cdr (assoc 420 maskClr))
                    )
                )
                ((and (= kWordBackgroundMask "Color")(= (assoc 420 maskClr) nil))
                    (setq mask_list (list (cons 90 1)(cons 63 (cdr (assoc 62 maskClr)))(cons 45 dOffset)(cons 441 2146608))
                          dxf90 1
                          dxf63 (cdr (assoc 62 maskClr))
                          dxf45 dOffset
                          dxf441 nil
                    )
                )
                ((= kWordBackgroundMask "Background")
                    (setq mask_list (list (cons 90 3)(cons 63 3)(cons 45 dOffset)(cons 441 0))
                          dxf90 3
                          dxf63 256
                          dxf45 dOffset
                          dxf441 0
                    )
                )
          )

          (setq emax (sslength ssMtext)
                sscount 0
          )

          (while (< sscount emax)
            (setq EN (entget (ssname ssMtext sscount))
		  tempEN nil)

            (if (/= dxf90 nil)
              (progn
                (if (/= (assoc 90 EN) nil)
                  (setq EN (subst (cons 90 dxf90) (assoc 90 EN) EN))
                  (setq EN (append EN (list (cons 90 dxf90))))
                )
              )
              (progn
                (setq CNT 0
                      nMembers (member (assoc 90 EN) EN))

                (if (= nMembers nil)
                  (setq nMembers 0)
		  (setq nMembers (length nMembers))
		)
                (repeat (- (length EN) nMembers)
                  (setq tempEN (append tempEN (list (nth cnt EN))))
                  (setq CNT (1+ CNT))
                )

		(if (> nMembers 0)
		  (progn
		    (setq CNT 1)
                    (repeat (- nMembers 1)
                      (setq tempEN (append tempEN (list (nth cnt (member (assoc 90 EN) EN)))))
                      (setq CNT (1+ CNT))
		    )
		  )
                )
                (setq EN tempEN
		      tempEN nil)
              )
            )

	    
            (if (/= dxf63 nil)
              (progn
                (if (/= (assoc 63 EN) nil)
                  (setq EN (subst (cons 63 dxf63) (assoc 63 EN) EN))
                  (setq EN (append EN (list (cons 63 dxf63))))
                )
              )
              (progn
                (setq CNT 0
                      nMembers (member (assoc 63 EN) EN))

                (if (= nMembers nil)
                  (setq nMembers 0)
		  (setq nMembers (length nMembers))
		)
                (repeat (- (length EN) nMembers)
                  (setq tempEN (append tempEN (list (nth cnt EN))))
                  (setq CNT (1+ CNT))
                )

		(if (> nMembers 0)
		  (progn
		    (setq CNT 1)
                    (repeat (- nMembers 1)
                      (setq tempEN (append tempEN (list (nth cnt (member (assoc 63 EN) EN)))))
                      (setq CNT (1+ CNT))
		    )
		  )
                )
                (setq EN tempEN
		      tempEN nil)
              )
            )

            (if (/= dxf45 nil)
              (progn
                (if (/= (assoc 45 EN) nil)
                  (setq EN (subst (cons 45 dxf45) (assoc 45 EN) EN))
                  (setq EN (append EN (list (cons 45 dxf45))))
                )
              )
              (progn
                (setq CNT 0
                      nMembers (member (assoc 45 EN) EN))

                (if (= nMembers nil)
                  (setq nMembers 0)
		  (setq nMembers (length nMembers))
		)
                (repeat (- (length EN) nMembers)
                  (setq tempEN (append tempEN (list (nth cnt EN))))
                  (setq CNT (1+ CNT))
                )

		(if (> nMembers 0)
		  (progn
		    (setq CNT 1)
                    (repeat (- nMembers 1)
                      (setq tempEN (append tempEN (list (nth cnt (member (assoc 45 EN) EN)))))
                      (setq CNT (1+ CNT))
		    )
		  )
                )
                (setq EN tempEN
		      tempEN nil)
              )
            )

            (if (/= dxf441 nil)
              (progn
                (if (/= (assoc 441 EN) nil)
                  (setq EN (subst (cons 441 dxf441) (assoc 441 EN) EN))
                  (setq EN (append EN (list (cons 441 dxf441))))
                )
              )
              (progn
                (setq CNT 0
                      nMembers (member (assoc 441 EN) EN))

                (if (= nMembers nil)
                  (setq nMembers 0)
		  (setq nMembers (length nMembers))
		)
                (repeat (- (length EN) nMembers)
                  (setq tempEN (append tempEN (list (nth cnt EN))))
                  (setq CNT (1+ CNT))
                )

		(if (> nMembers 0)
		  (progn
		    (setq CNT 1)
                    (repeat (- nMembers 1)
                      (setq tempEN (append tempEN (list (nth cnt (member (assoc 441 EN) EN)))))
                      (setq CNT (1+ CNT))
		    )
		  )
                )
                (setq EN tempEN)
              )
	      
            )

            (entmod EN)
            (setq sscount (1+ sscount))
          )
        )
      )
    )
  )
 (princ)
;)


;; -------------------------------------------------------------------------------------------------
;;    REFORMA ESTILO DE ACOTADO 
;;    El nombre del estilo es, en nuestro caso, "MBA-Flecha_-_2_5mm_Arial", creado por Revit al exportar.
;;    Cambiar según corresponda al estilo deseado
;; -------------------------------------------------------------------------------------------------

(command "-style" "DIM000" "Arial" "0" "1" "0" "N" "N")
  (setvar "DIMADEC" 0)
  (setvar "DIMALT" 0)
  (setvar "DIMALTD"           2)
  (setvar "DIMALTF"           25.4000)
  (setvar "DIMALTRND"         0.000)
  (setvar "DIMALTTD"          2)
  (setvar "DIMALTTZ"          0)
  (setvar "DIMALTU"           2)
  (setvar "DIMALTZ"           0)
  ;(setvar "DIMANNO"           1.000)
  (setvar "DIMAPOST"          "")
  (setvar "DIMARCSYM"         0)
  ;(setvar "DIMASO"            1)
  (setvar "DIMASSOC"          2)
  (setvar "DIMASZ"            3.000)
  (setvar "DIMATFIT"          3)
  (setvar "DIMAUNIT"          0)
  (setvar "DIMAZIN"           0)
  (setvar "DIMBLK"            "")
  (setvar "DIMBLK1"           "")
  (setvar "DIMBLK2"           "")
  (setvar "DIMCEN"            2.000)
  (setvar "DIMCLRD"           256)
  (setvar "DIMCLRE"           256)
  (setvar "DIMCLRT"           256)
  (setvar "DIMDEC"            0)
  (setvar "DIMDLE"            0.000)
  (setvar "DIMDLI"            8.000)
  (setvar "DIMDSEP"           ",")
  (setvar "DIMEXE"            2.000)
  (setvar "DIMEXO"            1.500)
  (setvar "DIMFIT"            5)
  (setvar "DIMFRAC"           0)
  (setvar "DIMFXL"            1.000)
  (setvar "DIMFXLON"          0)
  (setvar "DIMGAP"            1.000)
  ;(setvar "DIMJOGANG"         45.00)
  (setvar "DIMJUST"           0)
  (setvar "DIMLDRBLK"         "")
  (setvar "DIMLFAC"           1.0000)
  (setvar "DIMLIM"            0)
  (setvar "DIMLTEX1"          "BYBLOCK")
  (setvar "DIMLTEX2"          "BYBLOCK")
  (setvar "DIMLTYPE"          "BYBLOCK")
  (setvar "DIMLUNIT"          2)
  (setvar "DIMLWD"            -2)
  (setvar "DIMLWE"            -2)
  (setvar "DIMPOST"           "")
  (setvar "DIMRND"            0.000)
  (setvar "DIMSAH"            0)
  (setvar "DIMSCALE"          0.000)
  (setvar "DIMSD1"            0)
  (setvar "DIMSD2"            0)
  (setvar "DIMSE1"            0)
  (setvar "DIMSE2"            0)
  (setvar "DIMSHO"            1)
  (setvar "DIMSOXD"           0)
  (setvar "DIMTAD"            1)
  (setvar "DIMTDEC"           0)
  (setvar "DIMTFAC"           1.0000)
  (setvar "DIMTFILL"          0)
  (setvar "DIMTFILLCLR"       0)
  (setvar "DIMTIH"            0)
  (setvar "DIMTIX"            1)
  (setvar "DIMTM"             0.000)
  (setvar "DIMTMOVE"          2)
  (setvar "DIMTOFL"           0)
  (setvar "DIMTOH"            0)
  (setvar "DIMTOL"            0)
  (setvar "DIMTOLJ"           1)
  (setvar "DIMTP"             0.000)
  (setvar "DIMTSZ"            0.000)
  (setvar "DIMTVP"            0.0000)
  (setvar "DIMTXSTY"          "DIM000")
  (setvar "DIMTXT"            2.000)
  (setvar "DIMTZIN"           0)
  (setvar "DIMUNIT"           2)
  (setvar "DIMUPT"            0)
  (setvar "DIMZIN"            0)


  (command "-dimstyle" "save" "MBA-Flecha_-_2_5mm_Arial" "y")

;;;---------------------------------------------------------------------------;
;;;      Rutina que selecciona todo en un Viewport
;;;---------------------------------------------------------------------------;
;;;
;;; vpsel.lsp
;;;
;;; By Jimmy Bergmark
;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com
;;;
;;; 2000-04-14 - First release
;;; Tested on AutoCAD 2000
;;;
;;;---------------------------------------------------------------------------;
;;;  DESCRIPTION
;;;
;;;  Select all visible objects in selected or active paperspace viewport
;;;  Works transparently when in modelspace and for polygonal viewports too
;;;  Example1: ERASE ALL R 'VPC >>> Erase all in model except what is visible
;;;  Example2: (command "erase" "all" "r" (c:vpc) "")
;;;  Example3: VPC ERASE >>> VPC is run previous the command and the objects
;;;                            are also in previous selection set
;;;
;;;  c:vpc - select all visible objects with crossing in viewport
;;;  c:vpw - select all visible objects with window in viewport
;;;---------------------------------------------------------------------------;

(defun c:vpc ()
  (vpsel "C")
)

(defun c:vpw ()
  (vpsel "W")
)

(defun dxf (n ed) (cdr (assoc n ed)))

(defun vpsel (typ   /     ad    ss    ent   vpno  ok    vpbl  vpur
              msbl  msur  msul  mslr  ss1   pl    nlist x     n
             )
  (vl-load-com)
  (setq ok t)
  (if (= (getvar "tilemode") 0)
    (progn
      (setq ad (vla-get-activedocument (vlax-get-acad-object)))
      (if (= (getvar "cvport") 1)
        (if (and (= (getvar "cmdactive") 0)
                 (/= (setq ss (ssget ":E:S" '((0 . "VIEWPORT")))) nil)
            )
          (progn
            (setq ent (ssname ss 0))
            (setq vpno (dxf 69 (entget ent)))
            (vla-Display (vla-get-activepviewport ad) :vlax-true)
            (vla-put-mspace ad :vlax-true)
            (setvar "cvport" vpno)
          )
          (progn
            (setq ok nil)
            (princ)
          )
        )
        (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad)))
      )
      (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent))))))
        (progn
          (if (= (vla-get-clipped (vlax-ename->vla-object ent))
                 :vlax-false
              )
            (progn
              (vla-getboundingbox
                (vla-get-activepviewport ad)
                'vpbl
                'vpur
              )
              (setq msbl (trans (vlax-safearray->list vpbl) 3 2))
              (setq msur (trans (vlax-safearray->list vpur) 3 2))
              (setq msul (list (car msbl) (cadr msur)))
              (setq mslr (list (car msur) (cadr msbl)))
              (setq ss1
                     (ssget (strcat typ "P") (list msbl msul msur mslr))
              )
            )
            (progn
              (setq pl (entget (dxf 340 (entget ent))))
              (setq nlist nil)
              (foreach x pl
                (if (eq 10 (car x))
                  (setq nlist (cons (trans (cdr x) 3 2) nlist))
                )
              )
              (setq ss1 (ssget (strcat typ "P") nlist))
            )
          )
          (sssetfirst nil ss1)
          (if ss1
            (setq n (sslength ss1))
            (setq n 0)
          )
          (princ n)
          (princ " found ")
          (if (and ss1 (= (getvar "cmdactive") 1))
            ss1
            (princ)
          )
        )
        (princ)
      )
    )
    (princ)
  )
)

(princ)
;; -------------------------------------------------------------------------------------------------
;;    VIEWPORT LOCK
;; -------------------------------------------------------------------------------------------------

  (setq ESTETAB (getvar "ctab"))
  (setq VPLST (ssget "x" (list (cons 0 "viewport") (cons 410 ESTETAB))))
  (setq c -1)
  (if VPLST
  (repeat (sslength VPLST)
    (setq VPS (cdr (car (entget (ssname VPLST (setq c (1+ c)))))))
    (setq VLAOBJ (vlax-ename->vla-object VPS))
    (setq w-vp (vlax-get-property VLAOBJ 'Width))
    (setq h-vp (vlax-get-property VLAOBJ 'Height))
    (setq cs-vp (vlax-get-property VLAOBJ 'CustomScale))
    (setq w-vp (+ 3 w-vp))
    (setq h-vp (+ 3 h-vp))
    (vlax-put-property VLAOBJ 'Width w-vp)
    (vlax-put-property VLAOBJ 'Height h-vp)
    (vlax-put-property VLAOBJ 'CustomScale cs-vp)
;;;    (vlax-put-property VLAOBJ 'DisplayLocked :VLAX-TRUE)
    (vlax-put-property VLAOBJ 'Color 223)    
     ))
  (if (= (getvar "ctab") "Model")
    (princ "\n** Command not allowed in Model Tab **")
    (command "mview" "lock" "on" VPLST "")
  )

;;; Aplica estilo de acotado a cada viewport---------------------------------------------------------

(setq n (1- (sslength VPLST)))
(setq ni (sslength VPLST))

(repeat n
    (command "_.MSPACE")
    (setvar "CVPORT" ni)
    (command "-dimstyle" "_apply" (c:vpc) "")
    (setq ni (1- ni))
    (command "_.PSPACE")
  )
  (princ)
  
;-------------------------------------------------------------------------------------------------
;;;   Configura layer Viewports para No-Ploteo
;;;   El nombre del layer de viewports es "A-000-0-V-00"
;;;   Cambiar según convenga al estándar empleado
;-------------------------------------------------------------------------------------------------

  
(command "-LAYER" "P" "N" "A-000-0-V-00" "")
  
  
;-------------------------------------------------------------------------------------------------
;;;   Carga configuraciones de ploteo estándares
;;;   El archivo de configuración se llama "000 - MBA-PlotSetup.dwg"
;;;   Cambiar nombre y path según convenga, conservando las comillas.
;-------------------------------------------------------------------------------------------------

 (command "._-PSETUPIN" "M:/CAD/mbasim/dwt/000 - MBA-PlotSetup.dwg" "*")
  
;-------------------------------------------------------------------------------------------------
)
;;;; fin del archivo