Jump to content
Sign in to follow this  
kiks2021

LISP FOR UPDATING AND EXPORTING OBJECT TO A DWG THAT WILL BE AN XREF

Recommended Posts

kiks2021
;**********************************************************************
;Programa para usar la orden BLOQUEDISC a trav‚s de un camino escrito
;**********************************************************************
(defun *error* () (princ))
(defun noeco ()
  (setq valreg (getvar "regenmode")
        valeco (getvar "cmdecho")
  )
  (setvar "cmdecho" 0)
  (setvar "regenmode" 0)
)
(defun reco ()
  (setvar "regenmode" valreg)
  (setvar "cmdecho" valeco)
)
(defun CREA1 ()
        (command "BLOQUEDISC" TEXT "" P2 pause)
)
(defun CREA2 ( / OPCION)
        (initget 7 "Si No")
        (if (setq OPCION 
        (getkword "El fichero ya existe. ¨Deseas reemplazarlo? No/<Si>: ")) () 
            (setq OPCION "Si")
        )
        (command "BLOQUEDISC" TEXT OPCION "" P2 pause)
)
(defun COMPRUEBA ()        
        (setq TX 
        (subst (cons 1 DIRECC) (assoc 1 (entget ENT1)) (entget ENT1)))
        (entmod TX)                       
        (entupd ENT1)             
        (command "_.DDEDIT" ENT1 "")
        (setq TEXT (cdr (assoc 1 (entget ENT1))))  
)

(defun TEXT_F (/ H DWG PATH L M COD NUM NAMEW NAMEX PATH1 COD1 N DIRE
                DIREC)                
        (setq H 0)
        (setq DWG (getvar "DWGNAME"))
        (setq PATH (getvar "DWGPREFIX"))
        (setq L (strlen DWG))
        (setq M (strlen PATH))
        (setq COD (substr DWG L 1))
        (setq NUM 0)
        (while (/= COD "\\")
                (setq H (+ 1 H))                              
                (setq COD (substr DWG (- L H) 1))
        )
        (setq NAMEW (substr DWG (+ (- L H) 1)))
        (setq NAMEX (strcat "X" (substr NAMEW 2)))
        (setq PATH1 (substr PATH 1 (1- M)))
        (setq COD1 (substr PATH1 L 1))              
        (while (/= COD1 "\\")
               (setq NUM (1+ NUM))                              
               (setq COD1 (substr PATH1 (- M NUM) 1)) 
        )        
        (setq N (- M NUM))
        (setq DIRE (substr PATH 1 (- M NUM)))           
        (setq DIREC (strcat DIRE "X_REF\\")) 
        (setq DIRECC (strcat DIREC NAMEX))
)
(defun C:BDX ( / ENT1 TEXT STILE TBSTILE ALT_TEXT DIRECC)
        (noeco)
        (initget 6 "Xref Texto")
        (if (setq OP (getkword "dirigir a Xref <Texto a designar>")) ()
            (setq OP "Texto")
        )
        (if (= OP "Texto")
            (progn
                (command "_layer" "d" "-COMMENTS" "") 
                (setq ENT1 (car (entsel "\Selecciona un Texto:")))          
                (command "_.DDEDIT" ENT1 "")                  
                (setq TEXT (cdr (assoc 1 (entget ENT1))))              
            )    
        )    
        (if (= OP "Xref")
            (progn (TEXT_F)
                   (setq P1 (getpoint "\Indica Punto para insertar texto"))                        
                   (if (not (tblsearch "layer" "-COMMENTS"))
                       (command "_LAYER" "CR" "-COMMENTS" "")
                   )
                   (if (assoc "-COMMENTS" lstlayer)
                       (command "_LAYER" "color" (nth 1 (assoc "-COMMENTS" lstlayer)) "-COMMENTS" "")
                   )
                   (command "_LAYER" "D" "-COMMENTS" "EST" "-COMMENTS" "") 
                   (setq STILE (getvar "textstyle"))
                   (setq TBSTILE (tblsearch "style" STILE))
                   (setq ALT_TEXT (cdr (assoc 40 TBSTILE)))
                   
                   (If  (= ALT_TEXT 0)
                        (command "TEXTO" P1 2000 "" DIRECC)
                        (command "TEXTO" P1 "" DIRECC)
                   )
                   (setq ENT1 (entlast))
                   (COMPRUEBA)            
            )
        )
        (setq FICHERO (strcat text ".dwg"))
        (setq COMP (findfile (eval FICHERO)))
        (command "_ucs" "U" "_layer" "b" "cons,snap,-COMMENTS" "EST" "0" "")  
        (setq P2 (getpoint "Indica punto de inserci¢n de Bloque:")) (TERPRI)
        (if comp
            (CREA2)
            (CREA1)
        )
        (reco)
)

Hi everyone,

 

Here is a lisp for automating the BlockDisc command. I have not done this script but i want to get it to work properly. I know that it has to create a blockdisk and put it in a route by clicking a text object with the file's name that I want to create.

 

I don't understand LISP coding but I need to set that route. By default it appears to make the .dwg in the folder Documents. I want to set the rute the first time the blockdisc is done, and whenever I click the text, detect the route, ask me to select the objects and resave de new DWG which will be an XREF in other drawing.

 

If somebody can explain me what I should write or do. You can feel free to try.. I'm from Spain so the commands are written in spanish.

 

Thank you so much

BDX-mx.LSP

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this  

×
×
  • Create New...