Search the Community

Hi Everyone, I am trying to create an AutoLISP that will replace and/or automatically update an MText field (which in my case are the amendments for a drawing) in the Layouts tab for a series of drawings. The Lisp uses Lee Mac's Object DBX Wrapper and his get files routines (Thank you btw :)) to obtain the drawings and supply the function to each drawing. I am pretty new to Visual Lisps and only understand the basic functions like the vla-get-<item>. I am able to update the first drawing/opened drawing, however cannot seem to get the lisp to loop for each drawing selected. I suspect that it has something to do with vlax-for function but i do not completely understand it, especially when multiple drawings are being evaluated. Autolisp Code: ;--------------------------------EDIT BOX SAVE VARIABLES-----------------------------------; (Defun saveVars () (setq Date (get_tile "Date")) (setq Initials (get_tile "Initials")) (setq Subject (get_tile "Subject")) (setq Rev1 (atoi (get_tile "Rev1"))) (setq Prelim (atoi (get_tile "Prelim"))) (setq Tender (atoi (get_tile "Tender"))) ) ;-------------------------------------LOAD FILES------------------------------------------; (defun LoadFiles (a) (cond ((= a 1) (setq flst (LM:getfiles "select Drawings" nil "dwg"))) ) ) ;-----------------------------EDIT BOX LOAD AND FUNCTIONS----------------------------------; (defun C:Editbox ( ) (vl-load-com) (if (not (setq dcl_id (load_dialog "DCL_DCL_Editbox.dcl"))) (progn (alert "The DCL file could not be loaded.") (exit) ) (progn (if (not (new_dialog "DCL_Editbox" dcl_id)) (progn (alert "The DCL_DCL_Editbox could not be found inside the DCL file") (exit) ) (progn (action_tile "but1" "(LoadFiles 1)") (action_tile "accept" "(saveVars) (done_dialog 2)") (action_tile "cancel" "(done_dialog 1)") (setq ddiag (start_dialog)) (unload_dialog dcl_id) (if (= ddiag 1) (progn (print "Editbox cancelled!") (exit) ) ) (if (and (= ddiag 2) (and (= prelim 1) (= tender 1))) (exit) (LM:ODBX 'SC:T2 flst t) ) ) ) ) ) (princ) ) ;--------------------------------REWRITE AMENDMENTS FUNCTION-----------------------------------; (defun SC:T2 ( doc / ss1 lst2 lst RstrP StrPP RevNP RstrT StrPT RevNT) (vl-load-com) (vlax-for layout (vla-get-layouts doc) (vlax-for object (vlax-get (vla-get-activedocument (vlax-get-acad-object)) 'PaperSpace ) (if (= "AcDbMText" (vla-get-objectname object)) (setq lst (cons object lst)) ) (setq lst2 (car lst)) ) lst (setq ss1 (vlax-get-property lst2 'Textstring)) (progn (cond ((and (= rev1 1) (= Prelim 1)) (progn (vla-put-textstring lst2 (strcat "\\pxi-15,l15,tc2,c7,c12,15;\tP1\t" Date "\t" Initials "\t" Subject)) ) ) ((and (= rev1 1) (= tender 1)) (progn (vla-put-textstring lst2 (strcat "\\pxi-15,l15,tc2,c7,c12,15;\t00\t" Date "\t" Initials "\t" Subject)) ) ) ((= Prelim 1) (progn (setq RstrP (vl-list->string (reverse (vl-string->list ss1)))) (if (setq StrPP (vl-string-position (ascii "{") RstrP)) (setq RevNP (substr (vl-list->string (reverse (vl-string->list (substr RstrP (- StrPP 2) 2)))) 2 1)) (setq RevNP "1")) (vla-put-textstring lst2 (strcat ss1 "\\P{\t" (strcat "P" (rtos (+ (distof RevNP 2) 1) 2 3)) "\t" Date "\t" Initials "\t" Subject "}")) ) ) ((= Tender 1) (progn (setq RstrT (vl-list->string (reverse (vl-string->list ss1)))) (if (equal (vl-string-search "00" ss1) nil) (progn (vla-put-textstring lst2 (strcat ss1 "\\P{\t00\t" Date "\t" Initials "\t" Subject "}")) (exit) ) (if (setq StrPT (vl-string-position (ascii "{") RstrT)) (setq RevNT (substr (vl-list->string (reverse (vl-string->list (substr RstrT (- StrPT 2) 2)))) 2 1)) (setq RevNT "1")) ) (vla-put-textstring lst2 (strcat ss1 "\\P{\t" (strcat "0" (rtos (+ (distof RevNT 2) 1) 2 3)) "\t" Date "\t" Initials "\t" Subject "}")) ) ) ) ) (princ) ) ) ;--------------------------------GET TAB SPACING-----------------------------------; (defun _splitwords (str del / pos lst4 lst3 ss) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (_splitwords (substr str (+ pos 2))del)) (list str) ) ) (vlax-for obj2 (vlax-get (vla-get-activedocument (vlax-get-acad-object)) 'PaperSpace ) (if (= "AcDbMText" (vla-get-objectname obj2)) (setq lst4 (cons obj2 lst4)) ) (setq lst3 (car lst4)) ) lst4 (setq str (vlax-get-property lst3 'Textstring)) (_splitwords str "\t") DCL Code: DCL_Editbox : dialog { label = "Amendments Update"; : column { : boxed_column { : edit_box { key = "Date"; label = "Enter Date :"; edit_width = 5; value = "01.01.24"; initial_focus = true; } : edit_box { key = "Initials"; label = "Enter Initials :"; edit_width = 5; value = "XXX"; } : edit_box { key = "Subject"; label = "Enter Subject :"; edit_width = 25; value = "PRELIMINARY"; } } : boxed_column { : toggle { key = "Rev1"; label = "Check Box if this is First Revision."; value = "0"; } : toggle { key = "Prelim"; label = "Check Box if this is Preliminary."; value = "0"; } : toggle { key = "Tender"; label = "Check Box if this is Tender or Construction Issue."; value = "0"; } } : boxed_column { : button { key = "but1"; label = "Select Files"; is_default = false; } } : boxed_row { :button { key = "accept"; label = " Okay "; is_default = true; } : button { key = "cancel"; label = " Cancel "; is_default = false; is_cancel = true; } } } } I have found very little information on obtain MText on its own, not in a block, through ODBX and visual lisps; and even tried to wrap my head around Lee Mac's batch find and replace but could not quite work it out. Any help would be appreciated and if you need any additional info let me know. Thanks, Sol. P.S. This is my first post so apologies for any formatting errors and also thank you to everyone that has already helped with this lisp by providing functions on other topics/forums that have also been used here. Amendment Updates.lsp DCL_DCL_Editbox.dcl ODBX Wrapper.lsp Get Files.lsp

Hi, I am trying to copy a layer "DATE" from an old drawing file and then pasting to new drawing file. Following is the VBA code... Private Sub CommandButton1_Click() Dim oDoc As New AxDbDocument Dim nDoc As New AxDbDocument Dim newPath As String 'without layer and updated Dim oldPath As String 'to update UserForm1.Hide 'Call the copyLayer() CopyLayers newPath, oldPath End Sub Private Sub UserForm_Activate() oldPath = "E:\ACE\Testing\09Dec\oldFile.dwg" newPath = "E:\ACE\Testing\30Jan\newFile.dwg" savPath = "E:\ACE\Testing\09Dec\oldFile_Copy.dwg" End Sub 'To copy the Layers from newFile and pasting them to OldFile Public Sub CopyLayers(ByVal newFile As String, ByVal oldFile As String) Dim oDbx As Object 'To update i.e OLD FILE Dim nDbx As Object 'Updated i.e NEW FILE Dim olayer As AcadLayer Dim i As Integer With ThisDrawing.Application Set nDbx = .GetInterfaceObject("ObjectDBX.AxDbDocument.18") End With nDbx.Open FileName:=newFile 'Copying the Layers from Updated File i.e NEW FILE Dim copyLay() As Object For Each olayer In nDbx.Layers If UCase(olayer.Name) = "DATE" Then ReDim Preserve copyLay(i) Set copyLay(i) = olayer 'MsgBox olayer.Name i = i + 1 End If Next 'MsgBox i Dim idPairs As Variant 'Dim copyObj As Variant 'Opening the NEW FILE to copy the Layer With ThisDrawing.Application Set oDbx = .GetInterfaceObject("ObjectDBX.AxDbDocument.18") End With oDbx.Open FileName:=oldFile nDbx.CopyObjects copyLay, ThisDrawing.Application.ActiveDocument.ModelSpace, idPairs oDbx.SaveAs savPath Set oDbx = Nothing Set nDbx = Nothing End Sub There no error, but my old file is not getting updated.. !! Whats wrong with this code??? Regards JB

Generalising on an idea I've had for a while, I offer this program to allow you to import (humourously: 'steal') items from another drawing into the current drawing. Steal Upon running the program the user is prompted for a selection of a drawing to steal from, and, upon selection, a dialog appears detailing items available for import. The user may choose multiple items from a list of... Blocks Layers Linetypes Dimension Styles Text Styles Table Styles MLeader Styles MLine Styles Layouts Page Setups User Coordinate Systems Views Groups Layer States Scales Materials Viewports Drawing Properties Custom Properties ...should these collections contain any items which aren't already present in the current drawing. Dialog Preview A full description of the program and the latest version can be found here. Enjoy! Lee StealV1-8.lsp

Hi everyone, is there any ObjectDBX equivalent for getvar and setvar functions? Any reply or clue is fully appreciated.

Hi All Sorry this is a re-post. I couldn't work out how to move a post to the correct area. I need to read the Insbase value of an unopened drawing using ObjectDBX. I have already written code that can extract attributes and re-path xref's so the method of opening the drawing database is known. What I need to know is the property name of the Base or Insbase in Modelspace of a drawing. I have opened the drawing database as variable dbxdoc and using (vlax-dump-object (vla-get-ModelSpace dbxdoc)) I get: ; IAcadModelSpace: A special Block object containing all model space entities ; Property values: ; Application (RO) = Exception occurred ; BlockScaling = 0 ; Comments = "" ; Count (RO) = 96 ; Document (RO) = # ; Explodable = -1 ; Handle (RO) = "2" ; HasExtensionDictionary (RO) = -1 ; IsDynamicBlock (RO) = 0 ; IsLayout (RO) = -1 ; IsXRef (RO) = 0 ; Layout (RO) = # ; Name = "*MODEL_SPACE" ; ObjectID (RO) = 55 ; ObjectID32 (RO) = 55 ; ObjectName (RO) = "AcDbBlockTableRecord" ; Origin = (0.0 0.0 0.0) ; OwnerID (RO) = 56 ; OwnerID32 (RO) = 56 ; Path = AutoCAD.Application: Not applicable ; Units = 0 ; XRefDatabase (RO) = AutoCAD.Application: No database The property Origin is NOT the base for this drawing as the insbase is: Command: insbase Enter new value for INSBASE : The value for insbase must be accessable in the database somewhere but it is eluding me at this time. Thanks in advance for any responses, Colin

Hi all, the following code shows whether a text style is annotative (written by Lee): (defun LM:isAnnotative (style / object annotx) (and (setq object (tblobjname "STYLE" style)) (setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative"))))) (= 1 (cdr (assoc 1070 (reverse annotx)))) ) ) Is it possible to call tblobjname on a drawing which is opened as a ObjectDBX?

Hi All, who knows whether it is possible to change drawing properties without opening it using ObjectDBX or not? If so how to save the new properties to the drawing file? I greatly appreciate any help.

Spurred into life by this thread, I thought I'd update an old program of mine. I have created this program to enable a user to extract the layer information from multiple drawings in a directory to either Text/CSV file. Example of XML data output using XSL to display data in a CSS styled HTML Table: Enjoy! Lee Code can be found here