Rayan Lobo Posted November 1, 2022 Posted November 1, 2022 (edited) I found an AutoLISP program in forums. It works partially. Its supposed to create 2 commands 1. DwgPropExp --> Exports the attributes from drawing properties to a .prp file 2. DwgPropImp--> Imports the attributes from .prp file to drawing properties The first (DwgPropExp) works properly but autocad gives an error when executing the second (DwgPropImp) Would appreciate it if someone could help me resolve it since i've just started learning AutoLISP Below is the code: C:\Program Files\DSA\ACAD Tools\DwgProp.LSP;; Properties Import / Export / Utilities ;; by Irn� Barnard ;; Setup global variables (setq iPropStanList (list "DWGNAME" "Title" "Subject" "Author" "Keywords" "Comments" "RevisionNumber" "HyperlinkBase" "LastSavedBy") iPropStandard (length iPropStanList) ;Number of standard properties at start of list ) ;_ end of setq (vl-load-com) ;; Function to return the properties from the current drawing (defun GetDwgProps ( si / lst ) ;Get all standard drawing properties (setq lst (list (vl-list* "DWGNAME" (strcat (getvar "DWGPREFIX") (getvar "DWGNAME"))) ;Store original drawing name (vl-list* "Title" (vla-get-title si)) ;Get Title property (vl-list* "Subject" (vla-get-subject si)) ;Get Subject property (vl-list* "Author" (vla-get-author si)) ;Get Author property (vl-list* "Keywords" (vla-get-keywords si)) ;Get Keywords property (vl-list* "Comments" (vla-get-comments si)) ;Get Comments property (vl-list* "RevisionNumber" (vla-get-revisionnumber si)) ;Get RevisionNumber property (vl-list* "HyperlinkBase" (vla-get-hyperlinkbase si)) ;Get HyperlinkBase property (vl-list* "LastSavedBy" (vla-get-lastsavedby si)) ;Get LastSavedBy property ) ) ;Get all custom drawing properties (setq n (1- (vlax-invoke-method si 'NumCustomInfo))) ;Set counter to 0 & get number of custom properties (while (>= n 0) ;Step through all custom properties (vlax-invoke-method si 'GetCustomByIndex n 'pname 'pdata) ;Get custom property number n (setq lst (append lst (list (vl-list* pname pdata)))) ;Append to list (setq n (1- n)) ) lst ;Return new list ) ;End of GetDwgProps ;; Export Drawing Properties (defun c:DwgPropExp ( / fn doc db si fid lst n pname pdata ) (setq fn (strcat;Get default filename from current drawing name (getvar "DWGPREFIX") ;Get path to current drawing (vl-filename-base (getvar "DWGNAME")) ;Get name of current drawing, excl. extension ".PRP" ;Set different extension ) ;_ end of strcat ) ;_ end of setq (if (setq fn (getfiled "DwgProp Save" fn "prp" 1)) ;Let user select filename (progn (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))) ;get vl object for current drawing (setq db (vla-get-Database doc)) ;get vl object for drawing db (setq si (vla-get-SummaryInfo db)) ;get vl object for drawing properties (setq lst (GetDwgProps si)) ;get current drawing's properties ;Save list to file (setq fid (open fn "w") pname (length lst) n 0) ;open / create file for saving properties (while (< n pname) ;step through list (setq pdata (nth n lst)) ;get nth element of list (print pdata fid) ;write the current list item to the file (setq n (1+ n)) ) (close fid) (princ (strcat "Finished exporting drawing properties to [" fn "].")) ) (princ "Export drawing properties - Canceled by user.") ) (princ) ) ;; Import Drawing Properties (defun c:DwgPropImp ( / fn fid lst line doc db si dcl_id lst0 lst1 lst2 lstp n str sellst1 sellst2 ) (setq fn (strcat;Get default filename from current drawing name (getvar "DWGPREFIX") ;Get path to current drawing (vl-filename-base (getvar "DWGNAME")) ;Get name of current drawing, excl. extension ".PRP" ;Set different extension ) ;_ end of strcat ) ;_ end of setq (if (setq fn (getfiled "DwgProp Open" fn "prp" 0)) ;Let user select filename (progn (setq fid (open fn "r") lst (list)) ;Open File for reading (while (setq line (read-line fid)) ;Read one line from file (setq lst (cons (read line) lst)) ;Add line to list ) (close fid) ;Close the file (setq lst (cdr (reverse lst))) ;Reverse list (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))) ;get vl object for current drawing (setq db (vla-get-Database doc)) ;get vl object for drawing db (setq si (vla-get-SummaryInfo db)) ;get vl object for drawing properties (setq lst0 (GetDwgProps si)) ;get current drawing's properties ;; Function to check if custom propery already exists (defun is-custom-p ( si name / n ret pname pdata pcount ) (setq ret nil n 0 pcount (vlax-invoke-method si 'NumCustomInfo)) (while (and (< n pcount) (not ret)) (vlax-invoke-method si 'GetCustomByIndex n 'pname 'pdata) (if (= pname name) (setq ret n) (setq n (1+ n))) ) ret ) ;End of is-custom-p ;; Function to toggle ignore / import / delete (defun togle-import ( opt / act n lstname str1 sellst srclst) (cond ((= opt 0) (setq act "N")) ((= opt 1) (setq act "Y")) ((= opt 2) (setq act "D")) ((= opt 3) (setq act "N")) ) (if (> opt 1) (setq lstname "LstOld" sellst sellst2 srclst lst0) ;Set deleted values (setq lstname "LstNew" sellst sellst1 srclst lst) ;Set import / ignore values ) ;; Step through selected list (setq n 0) (while (< n (length sellst)) (if (or (/= opt 2) (>= (nth n sellst) (1- iPropStandard))) (progn (start_list lstname 1 (nth n sellst)) ;Start editing list at index from selected list (add_list (strcat act " = " (car (nth (1+ (nth n sellst)) srclst)))) ;Set new prefix (end_list) ) ) (cond ((= opt 0) ;Set ignored list items (setq lst1 (subst (vl-list* (car (nth (1+ (nth n sellst)) srclst)) nil) (assoc (car (nth (1+ (nth n sellst)) srclst)) lst1) lst1))) ((= opt 1) ;Set imported list items (setq lst1 (subst (vl-list* (car (nth (1+ (nth n sellst)) srclst)) T) (assoc (car (nth (1+ (nth n sellst)) srclst)) lst1) lst1))) ((and (= opt 2) (>= (1+ (nth n sellst)) iPropStandard)) ;Set deleted list items (setq lst2 (subst (vl-list* (car (nth (1+ (nth n sellst)) srclst)) T) (assoc (car (nth (1+ (nth n sellst)) srclst)) lst2) lst2))) ((= opt 3) ;Set non-deleted list items (setq lst2 (subst (vl-list* (car (nth (1+ (nth n sellst)) srclst)) nil) (assoc (car (nth (1+ (nth n sellst)) srclst)) lst2) lst2))) ) (setq n (1+ n)) ) ) ;End of togle-import ;; Function to check selection for similarities (defun update-list ( OldNew val lst / str1 newstr n lst) (setq str1 (vl-string-right-trim " \t\n" (vl-string-left-trim " \t\n" val)) newstr nil) ;Init variables (if (= OldNew 0) (setq sellst2 nil) ;Init old selected list (setq sellst1 nil) ;Init new selected list ) (while (> (strlen str1) 0) ;Step through string until all numbers removed (setq n (read str1)) ;Get 1st number in string ;;Check if value differs (if (and newstr (/= newstr (cdr (nth (1+ n) lst)))) (setq newstr "*VARIES*") ;Set value to show that it differs (if (not newstr) ;Else if the string hasn't been assigned yet (setq newstr (cdr (nth (1+ n) lst))) ;Set string to show value ) ) (setq str1 (vl-string-left-trim " \t\n" (substr str1 (1+ (strlen (itoa n)))))) ;Remove 1st number from string (if (= OldNew 0) (setq sellst2 (cons n sellst2)) ;Add number to old selected list (setq sellst1 (cons n sellst1)) ;Add number to new selected list ) ) (if (= OldNew 0) (set_tile "ValOld" newstr) ;Show value string in ValOld edit field (set_tile "ValNew" newstr) ;Else show value string in ValNew edit field ) ) ;End of update-list ;; Open dialog & initialize values (setq dcl_id (load_dialog "DwgProp.DCL")) ;Load DCL file (if (not (new_dialog "PropImport" dcl_id)) (exit)) ;Create iPropImort dialog (set_tile "txtDescr" (strcat "Select those properties you want to import. " "By default all standard properties will not be imported, " "while all custom properties will. " "Prefix Key: Y=Import; N=Ignore; D=Delete")) (set_tile "PrevDWG" (cdr (assoc "DWGNAME" lst))) ;Set edit box value of prev drawing name (setq lst1 nil lst2 nil lstp nil) ;Initialize list variables ;; Load new values into listbox (start_list "LstNew" 3) ;Start editing list (setq n 1) ;Start loading list from 2nd item (1st is DWG Name) (while (< n (length lst)) (if (< n iPropStandard) ;Check if list item is standard property (progn (setq str "N") ;Set to ignore (setq lst1 (cons (vl-list* (car (nth n lst)) nil) lst1)) ;Add to changed / added list not marked for import ) (progn (setq str "Y") ;Else set to import (setq lst1 (cons (vl-list* (car (nth n lst)) T) lst1)) ;Add to changed / added list marked for import ) ) (setq str (strcat str " = " (car (nth n lst)))) ;Get nth item from list (add_list str) ;Add to listbox (setq n (1+ n)) ) (end_list) ;Close list editing ;; Load current values into listbox (start_list "LstOld" 3) ;Start editing list (setq n 1) ;Start loading list from 2nd item (1st is DWG Name) (while (< n (length lst0)) (setq str (strcat "N = " (car (nth n lst0)))) ;Get nth item from list (add_list str) ;Add to listbox (setq lst2 (cons (vl-list* (car (nth n lst0)) nil) lst2)) ;Add to delete list not marked for delete (setq n (1+ n)) ) (end_list) ;Close list editing (action_tile "LstNew" "(update-list 1 $value lst)") ;Set action for selection update of new list (action_tile "LstOld" "(update-list 0 $value lst0)") ;Set action for selection update of old list (action_tile "btnIgn" "(togle-import 0)") ;Set action for ignore button (action_tile "btnImp" "(togle-import 1)") ;Set action for import button (action_tile "btnDel" "(togle-import 2)") ;Set action for delete button (action_tile "btnDNo" "(togle-import 3)") ;Set action for delete button ;; fn fid lst line doc db si dcl_id lst0 lst1 lst2 lstp sellst1 sellst2 (if (= 1 (start_dialog)) ;Display the dialog (progn ;If OK start import ;; Delete custom properties marked for deletion (setq n 0) (while (< n (length lst2)) (setq str (car (nth n lst2))) (if (and (not (vl-position str iPropStanList)) (cdr (nth n lst2))) (vlax-invoke-method si "RemoveCustomByKey" str) ) (setq n (1+ n)) ) ;; Import values marked for import (setq n 0) (while (< n (length lst1)) (setq str (car (nth n lst1)) lstp (assoc str lst)) (if (vl-position str iPropStanList) ;Check if standard property (vlax-put-property si str (cdr lstp)) ;Set standard property (if (assoc str lst0) ;Else Check if custom key exists (vlax-invoke-method si "SetCustomByKey" str (cdr lstp)) ;Change custom key's value (vlax-invoke-method si "AddCustomInfo" str (cdr lstp)) ;Else add custom key ) ) (setq n (1+ n)) ) ) ) (unload_dialog dcl_id) ;Unload DCL from memory (princ (strcat "Finished importing drawing properties from [" fn "].")) ) (princ "Import drawing properties - Canceled by user.") ) (princ) ) Edited November 2, 2022 by SLW210 Added CODE TAGS!! Quote
rlx Posted November 1, 2022 Posted November 1, 2022 it looks like you're missing a file : DwgProp.DCL ;; Open dialog & initialize values (setq dcl_id (load_dialog "DwgProp.DCL")) ;Load DCL file (if (not (new_dialog "PropImport" dcl_id)) (exit) ) ;Create iPropImort dialog you could try : (if (not (setq fn (findfile "DwgProp.DCL"))) (progn (alert "Dialog file missing - exit program")(exit))(setq dcl_id (load_dialog fn))) Quote
tombu Posted November 2, 2022 Posted November 2, 2022 So does it work just like the PROPULATE command? I used to use that many years ago. Lots of lisp out there but all heavily customized for the users they were created for. I have one that sets them all initially like setting the Title to the drawing name without the extension (if(=(vla-get-Title SummaryInfo) "")(vla-put-Title SummaryInfo (vl-filename-base (getvar "dwgname")))) another adds the "Drawn By:" name used by whoever has the drawing open: another adds the "Engineer of Record" with their license number from a drop-down list of engineers in our office for the signature box. another prompts for entering the number of the field book the notes are in for creating this drawing which has to be shown on all our drawings. Quote
Rayan Lobo Posted November 16, 2022 Author Posted November 16, 2022 @tombu Yes it does work similar to populate but instead of AutoCAD to AutoCAD I'm trying to get excel to autocad Quote
Rayan Lobo Posted November 16, 2022 Author Posted November 16, 2022 @rlx I modified this section and updated it to the original code but to no avail. I do have the DwgProp.DCL file I have attached it here I modified this section and updated it to the original code but to no avail. On 11/2/2022 at 2:33 AM, rlx said: you could try : (if (not (setq fn (findfile "DwgProp.DCL"))) (progn (alert "Dialog file missing - exit program")(exit))(setq dcl_id (load_dialog fn))) I tried replacing the file name with the file path itself as well but that failed too ;; Open dialog & initialize values (setq dcl_id (load_dialog "C:\........\DwgProp.DCL")) ;Load DCL file (if (not (setq fn (findfile "C:\........\DwgProp.DCL"))) (progn (alert "Dialog file missing - exit program")(exit))(setq dcl_id (load_dialog fn))) ;Create iPropImort dialog I found a code at https://autolisp-exchange.com/AutoLISP-Code.htm attached below but that simply does not work. It fails at creating new functions itself ;------------------------------------------------------------------------------- ; Program Name: GetExcel.lsp [GetExcel R10] ; Created By: Terry Miller (Email: terrycadd@yahoo.com) ; (URL: https://autolisp-exchange.com) ; Date Created: 9-20-03 ; Function: Several functions to get and put values into Excel cells. ;------------------------------------------------------------------------------- ; Revision History ; Rev By Date Description ;------------------------------------------------------------------------------- ; 1 TM 9-20-03 Initial version ; 2 TM 8-20-07 Rewrote GetExcel.lsp and added several new sub-functions ; including ColumnRow, Alpha2Number and Number2Alpha written ; by Gilles Chanteau from Marseille, France. ; 3 TM 12-1-07 Added several sub-functions written by Gilles Chanteau ; including Cell-p, Row+n, and Column+n. Also added his ; revision of the PutCell function. ; 4 GC 9-20-08 Revised the GetExcel argument MaxRange$ to accept a nil ; and get the current region from cell A1. ; 5 TM 4-7-14 Revised error routine to work with script files. ; 6 TM 5-1-20 Revised GetExcel to be able to retrieve the data from a list ; of Sheet names and a list of Max ranges in one call to GetExcel. ; 7 TM 3-20-21 Revised the GetExcel argument SheetName$ to accept a nil ; and get the current Sheet tab name as the default. ; 8 TM 9-1-22 Revised CloseExcel to include the extensions .xlsx, .xls and .csv. ; 9 TM 9-20-22 Revised the GetExcel argument MaxRange$, replacing CurrentRegion ; to UsedRange in the sub-function CreateLists: to get all of the ; Used Range. This is so much faster that the CurrentRegion method ; that was used previously. ; 10 TM 10-1-22 Revised GetExcel to not close other Excel spreadsheets that ; are open. Included the variable ShowInformation for the user ; to customize to show or not show the information messages. ;------------------------------------------------------------------------------- ; Overview of Main functions ;------------------------------------------------------------------------------- ; GetExcel - Stores the values from an Excel spreadsheet into *ExcelData@ list ; Syntax: (GetExcel ExcelFile$ SheetName$ MaxRange$) ; Example 1: (GetExcel "C:\\Folder\\Filename.xlsx" "Sheet1" "L30") ; Example 2: (GetExcel "C:\\Folder\\Filename.xlsx" (list "Sheet1" "Sheet2") (list "L30" "H747")) ; GetCell - Returns the cell value from the *ExcelData@ list ; Syntax: (GetCell Cell$) ; Example: (GetCell "H15") ; Function example of usage: ; (defun c:Get-Example () ; (GetExcel "C:\\Folder\\Filename.xlsx" "Sheet1" "L30");<-- Edit Filename.extension ; (GetCell "H21");Or you can just use the global *ExcelData@ list ; );defun ;------------------------------------------------------------------------------- ; OpenExcel - Opens an Excel spreadsheet ; Syntax: (OpenExcel ExcelFile$ SheetName$ Visible) ; Example: (OpenExcel "C:\\Folder\\Filename.xlsx" "Sheet1" nil) ; PutCell - Put values into Excel cells ; Syntax: (PutCell StartCell$ Data$) or (PutCell StartCell$ DataList@) ; Example: (PutCell "A1" (list "GP093" 58.5 17 "Base" "3'-6 1/4\"")) ; CloseExcel - Closes Excel session ; Syntax: (CloseExcel ExcelFile$) ; Example: (CloseExcel "C:\\Folder\\Filename.xlsx") ; Example: (CloseExcel "C:\\Folder\\Filename.xls") ; Example: (CloseExcel "C:\\Folder\\Filename.csv") ; Example: (CloseExcel nil);<-- Close without saving ; Function example of usage: ; (defun c:Put-Example () ; (OpenExcel "C:\\Folder\\Filename.xlsx" "Sheet1" nil);<-- Edit Filename.extension ; (PutCell "A1" (list "GP093" 58.5 17 "Base" "3'-6 1/4\""));Repeat as required ; (CloseExcel "C:\\Folder\\Filename.xlsx");<-- Edit Filename.extension ; (princ) ; );defun ;------------------------------------------------------------------------------- ; Note: Review the conditions of each argument in the function headings ;------------------------------------------------------------------------------- ; GetExcel - Stores the values from an Excel spreadsheet into *ExcelData@ list ; Arguments: 3 ; ExcelFile$ = Path and filename ; SheetName$ = Sheet name or nil for not specified or a list of Sheet names like (list "Sheet1" "Sheet2" "Sheet3") ; MaxRange$ = Maximum cell ID range to include or nil to get all of the UsedRange from cell A1 ; or a list of Maximum cell ranges corresponding to the SheetNames list like (list "H40" "D72" "N237" ...) ; or (list nil nil nil ...) to get all of the Used Range in every SheetName$ list. ; Syntax examples: ; (GetExcel "C:\\Temp\\Temp.xlsx" "Sheet1" "E19") = Open C:\Temp\Temp.xlsx on Sheet1 and read up to cell E19 ; (GetExcel "C:\\Temp\\Temp.xlsx" nil "XYZ123") = Open C:\Temp\Temp.xlsx on current sheet and read up to cell XYZ123 ; (GetExcel "C:\\Temp\\Temp.xlsx" (list "Sheet1" "Sheet2" "Sheet3") (list "H40" "D72" "N237")) = Open Sheets in the ; SheetName list and read up to the corresponding Maximum cell range in the MaxRange list. To separate the data ; for each Sheet name use a method like: (setq Sheet1@ (nth 0 *ExcelData@)) (setq Sheet2@ (nth 1 *ExcelData@)) ; and (setq Sheet3@ (nth 2 *ExcelData@)) per this example. ; (GetExcel "C:\\Temp\\Temp.xlsx" (list "Sheet1" "Sheet2" "Sheet3") (list nil "D72" nil)) = Open Sheets in the ; SheetName list and read up to the corresponding Maximum cell range in the MaxRange list, or if it's a nil read ; in all of the Used Range for that SheetName. To separate the data for each Sheet name use a method like: ; (setq Sheet1@ (nth 0 *ExcelData@)) (setq Sheet2@ (nth 1 *ExcelData@)) and (setq Sheet3@ (nth 2 *ExcelData@)) ; per this example. ;------------------------------------------------------------------------------- (defun GetExcel (ExcelFile$ SheetName$ MaxRange$ / Cnt# Column# ColumnRow@ CreateLists: Data@ ExcelList@ ExcelValue$ Max_Range$ MaxColumn# MaxRow# Row# RowList@ Sheet^ Sheet_Name$ ShowInformation Worksheet^ x) ;----------------------------------------------------------------------------- ; CreateLists: - Creates Lists of SheetName$ up to MaxRange$ of Excel data ;----------------------------------------------------------------------------- (defun CreateLists: (Sheet_Name$ Max_Range$ / ReturnList@) (if Sheet_Name$ (vlax-for Worksheet^ (vlax-get-property *ExcelApp% "Sheets") (if (= (vlax-get-property Worksheet^ "Name") Sheet_Name$) (vlax-invoke-method Worksheet^ "Activate") );if );vlax-for (setq Sheet_Name$ (vlax-get-property (vlax-get-property (vlax-get-property *ExcelApp% "ActiveWorkbook") "ActiveSheet") 'Name) );setq );if (setq Sheet^ (vlax-get-property (vlax-get-property *ExcelApp% 'Sheets) 'Item Sheet_Name$)) (setq ExcelList@ (mapcar '(lambda (x) (mapcar 'vlax-variant-value x)) (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-get-property Sheet^ 'UsedRange) 'Value)) );vlax-safearray->list );mapcar );setq (if Max_Range$ (progn (setq ColumnRow@ (ColumnRow Max_Range$)) (setq MaxColumn# (nth 0 ColumnRow@)) (setq MaxRow# (nth 1 ColumnRow@)) (setq Row# 0) (repeat MaxRow# (setq Data@ nil) (if (not (setq RowList@ (nth Row# ExcelList@))) (setq RowList@ (list "")) );if (setq Column# 0) (repeat MaxColumn# (setq ExcelValue$ (nth Column# RowList@)) (setq ExcelValue$ (cond ((= (type ExcelValue$) 'INT) (itoa ExcelValue$)) ((= (type ExcelValue$) 'REAL) (rtosr ExcelValue$)) ((= (type ExcelValue$) 'STR) (vl-string-trim " " ExcelValue$)) ((/= (type ExcelValue$) 'STR) "") );cond );setq (setq Data@ (append Data@ (list ExcelValue$))) (setq Column# (1+ Column#)) );repeat (setq ReturnList@ (append ReturnList@ (list Data@))) (setq Row# (1+ Row#)) );repeat );progn (foreach RowList@ ExcelList@ (setq Data@ nil) (foreach ExcelValue$ RowList@ (setq ExcelValue$ (cond ((= (type ExcelValue$) 'INT) (itoa ExcelValue$)) ((= (type ExcelValue$) 'REAL) (rtosr ExcelValue$)) ((= (type ExcelValue$) 'STR) (vl-string-trim " " ExcelValue$)) ((/= (type ExcelValue$) 'STR) "") );cond );setq (setq Data@ (append Data@ (list ExcelValue$))) );foreach (setq ReturnList@ (append ReturnList@ (list Data@))) );foreach );if ReturnList@ );defun CreateLists: ;----------------------------------------------------------------------------- (setq ShowInformation t); Show Information Message, t or nil (if (= (type ExcelFile$) 'STR) (if (not (findfile ExcelFile$)) (progn (alert (strcat "Excel file " ExcelFile$ " not found."))(exit)) );if (progn (alert "Excel file not specified.")(exit)) );if (setq ExcelFile$ (findfile ExcelFile$))(gc) (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application")) (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$) (setq *ExcelData@ nil) (if (= (type SheetName$) 'LIST) (progn (if (/= (type MaxRange$) 'LIST) (setq MaxRange$ (list MaxRange$)) );if (setq Cnt# 0) (repeat (length SheetName$) (setq Sheet_Name$ (nth Cnt# SheetName$)) (setq Max_Range$ (nth Cnt# MaxRange$)) (if ShowInformation (progn (princ (strcat "\nImporting " (vl-filename-base ExcelFile$) " - " Sheet_Name$ " data..."))(princ)) );if (setq ReturnList@ (CreateLists: Sheet_Name$ Max_Range$)) (setq *ExcelData@ (append *ExcelData@ (list ReturnList@))) (setq Cnt# (1+ Cnt#)) );repeat );progn (progn (if (= SheetName$ nil) (setq SheetName$ (vlax-get-property (vlax-get-property (vlax-get-property *ExcelApp% "ActiveWorkbook") "ActiveSheet") 'Name) );setq );if (if ShowInformation (progn (princ (strcat "\nImporting " (vl-filename-base ExcelFile$) " - " SheetName$ " data..."))(princ)) );if (setq *ExcelData@ (CreateLists: SheetName$ MaxRange$)) );progn );if (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close ExcelFile$) (setq *ExcelApp% nil) *ExcelData@ );defun GetExcel ;------------------------------------------------------------------------------- ; GetCell - Returns the cell value from the *ExcelData@ list ; Arguments: 1 ; Cell$ = Cell ID ; Syntax example: (GetCell "E19") = value of cell E19 ;------------------------------------------------------------------------------- (defun GetCell (Cell$ / Column# ColumnRow@ Return$ Row#) (setq ColumnRow@ (ColumnRow Cell$)) (setq Column# (1- (nth 0 ColumnRow@))) (setq Row# (1- (nth 1 ColumnRow@))) (setq Return$ "") (if *ExcelData@ (if (and (>= (length *ExcelData@) Row#)(>= (length (nth 0 *ExcelData@)) Column#)) (setq Return$ (nth Column# (nth Row# *ExcelData@))) );if );if Return$ );defun GetCell ;------------------------------------------------------------------------------- ; OpenExcel - Opens an Excel spreadsheet ; Arguments: 3 ; ExcelFile$ = Excel filename or nil for new spreadsheet ; SheetName$ = Sheet name or nil for not specified ; Visible = t for visible or nil for hidden ; Syntax examples: ; (OpenExcel "C:\\Temp\\Temp.xlsx" "Sheet2" t) = Opens C:\Temp\Temp.xlsx on Sheet2 as visible session ; (OpenExcel "C:\\Temp\\Temp.xlsx" nil nil) = Opens C:\Temp\Temp.xlsx on current sheet as hidden session ; (OpenExcel nil "Parts List" nil) = Opens a new spreadsheet and creates a Part List sheet as hidden session ;------------------------------------------------------------------------------- (defun OpenExcel (ExcelFile$ SheetName$ Visible / Sheet$ Sheets@ Worksheet^) (if (= (type ExcelFile$) 'STR) (if (findfile ExcelFile$) (setq *ExcelFile$ ExcelFile$) (progn (alert (strcat "Excel file " ExcelFile$ " not found.")) (exit) );progn );if (setq *ExcelFile$ "") );if (gc) (if (setq *ExcelApp% (vlax-get-object "Excel.Application")) (progn (vlax-release-object *ExcelApp%)(gc) );progn );if (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application")) (if ExcelFile$ (if (findfile ExcelFile$) (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$) (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add) );if (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add) );if (if Visible (vla-put-visible *ExcelApp% :vlax-true) );if (if (= (type SheetName$) 'STR) (progn (vlax-for Sheet$ (vlax-get-property *ExcelApp% "Sheets") (setq Sheets@ (append Sheets@ (list (vlax-get-property Sheet$ "Name")))) );vlax-for (if (member SheetName$ Sheets@) (vlax-for Worksheet^ (vlax-get-property *ExcelApp% "Sheets") (if (= (vlax-get-property Worksheet^ "Name") SheetName$) (vlax-invoke-method Worksheet^ "Activate") );if );vlax-for (vlax-put-property (vlax-invoke-method (vlax-get-property *ExcelApp% "Sheets") "Add") "Name" SheetName$) );if );progn );if (princ) );defun OpenExcel ;------------------------------------------------------------------------------- ; PutCell - Put values into Excel cells ; Arguments: 2 ; StartCell$ = Starting Cell ID ; Data@ = Value or list of values ; Syntax examples: ; (PutCell "A1" "PART NUMBER") = Puts PART NUMBER in cell A1 ; (PutCell "B3" '("Dim" 7.5 "9.75")) = Starting with cell B3 put Dim, 7.5, and 9.75 across ;------------------------------------------------------------------------------- (defun PutCell (StartCell$ Data@ / Cell$ Column# ExcelRange^ Row#) (if (= (type Data@) 'STR) (setq Data@ (list Data@)) );if (setq ExcelRange^ (vlax-get-property *ExcelApp% "Cells")) (if (Cell-p StartCell$) (setq Column# (car (ColumnRow StartCell$)) Row# (cadr (ColumnRow StartCell$)) );setq (if (vl-catch-all-error-p (setq Cell$ (vl-catch-all-apply 'vlax-get-property (list (vlax-get-property *ExcelApp% "ActiveSheet") "Range" StartCell$))) );vl-catch-all-error-p (alert (strcat "The cell ID \"" StartCell$ "\" is invalid.")) (setq Column# (vlax-get-property Cell$ "Column") Row# (vlax-get-property Cell$ "Row") );setq );if );if (if (and Column# Row#) (foreach Item Data@ (vlax-put-property ExcelRange^ "Item" Row# Column# (vl-princ-to-string Item)) (setq Column# (1+ Column#)) );foreach );if (princ) );defun PutCell ;------------------------------------------------------------------------------- ; CloseExcel - Closes Excel spreadsheet ; Arguments: 1 ; ExcelFile$ = Excel Saveas filename or nil to close without saving ; Syntax examples: ; (CloseExcel "C:\\Temp\\Temp.xlsx") = Saveas C:\Temp\Temp.xlsx and close ; (CloseExcel "C:\\Temp\\Temp.xls") = Saveas C:\Temp\Temp.xls and close) ; (CloseExcel "C:\\Temp\\Temp.csv") = Saveas C:\Temp\Temp.csv and close) ; (CloseExcel nil) = Close without saving ;------------------------------------------------------------------------------- (defun CloseExcel (ExcelFile$ / Extension$ Message$ Saveas) (if (= (type ExcelFile$) 'STR) (if (setq Extension$ (vl-filename-extension ExcelFile$)) (progn (setq Extension$ (strcase Extension$ t)) (if (member Extension$ (list ".xlsx" ".xls" ".csv"));Add new extensions here (progn (setq Saveas t) (if (and (findfile ExcelFile$) (= (strcase ExcelFile$) (strcase *ExcelFile$))) (progn (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "Save") (setq Saveas nil) );progn (if (findfile ExcelFile$) (vl-file-delete (findfile ExcelFile$)) );if );if );progn (progn (setq Message$ (strcat "The extension " Extension$ " is not included in the CloseExcel function." "\nPlease review the website link in the function CloseExcel in" "\nGetExcel.lsp to edit this function as needed.") );setq (alert Message$); Website link: ; https://docs.microsoft.com/en-us/office/vba/api/excel.xlfileformat?source=recommendations );progn );if );progn );if );if (if Saveas (cond ((= Extension$ ".xlsx") (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "Saveas" ExcelFile$ 51 "" "" :vlax-false :vlax-false nil);.xlsx = 51 );case ((= Extension$ ".xls") (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "Saveas" ExcelFile$ -4143 "" "" :vlax-false :vlax-false nil);.xls = -4143 );case ((= Extension$ ".csv") (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "Saveas" ExcelFile$ 6 "" "" :vlax-false :vlax-false nil);.csv = 6 );case ;Add new extension cases here );cond );if (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False) (vlax-invoke-method *ExcelApp% 'Quit) (vlax-release-object *ExcelApp%)(gc) (setq *ExcelApp% nil *ExcelFile$ nil) (princ) );defun CloseExcel ;------------------------------------------------------------------------------- ; ColumnRow - Returns a list of the Column and Row number ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Cell$ = Cell ID ; Syntax example: (ColumnRow "ABC987") = '(731 987) ;------------------------------------------------------------------------------- (defun ColumnRow (Cell$ / Column$ Char$ Row#) (setq Column$ "") (while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91) (setq Column$ (strcat Column$ Char$) Cell$ (substr Cell$ 2) );setq );while (if (and (/= Column$ "") (numberp (setq Row# (read Cell$)))) (list (Alpha2Number Column$) Row#) '(1 1);default to "A1" if there's a problem );if );defun ColumnRow ;------------------------------------------------------------------------------- ; Alpha2Number - Converts Alpha string into Number ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Str$ = String to convert ; Syntax example: (Alpha2Number "ABC") = 731 ;------------------------------------------------------------------------------- (defun Alpha2Number (Str$ / Num#) (if (= 0 (setq Num# (strlen Str$))) 0 (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#))) (Alpha2Number (substr Str$ 2)) );+ );if );defun Alpha2Number ;------------------------------------------------------------------------------- ; Number2Alpha - Converts Number into Alpha string ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Num# = Number to convert ; Syntax example: (Number2Alpha 731) = "ABC" ;------------------------------------------------------------------------------- (defun Number2Alpha (Num# / Val#) (if (< Num# 27) (chr (+ 64 Num#)) (if (= 0 (setq Val# (rem Num# 26))) (strcat (Number2Alpha (1- (/ Num# 26))) "Z") (strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#))) );if );if );defun Number2Alpha ;------------------------------------------------------------------------------- ; Cell-p - Evaluates if the argument Cell$ is a valid cell ID ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Cell$ = String of the cell ID to evaluate ; Syntax examples: (Cell-p "B12") = t, (Cell-p "BT") = nil ;------------------------------------------------------------------------------- (defun Cell-p (Cell$) (and (= (type Cell$) 'STR) (or (= (strcase Cell$) "A1") (not (equal (ColumnRow Cell$) '(1 1))) );or );and );defun Cell-p ;------------------------------------------------------------------------------- ; Row+n - Returns the cell ID located a number of rows from cell ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 2 ; Cell$ = Starting cell ID ; Num# = Number of rows from cell ; Syntax examples: (Row+n "B12" 3) = "B15", (Row+n "B12" -3) = "B9" ;------------------------------------------------------------------------------- (defun Row+n (Cell$ Num#) (setq Cell$ (ColumnRow Cell$)) (strcat (Number2Alpha (car Cell$)) (itoa (max 1 (+ (cadr Cell$) Num#)))) );defun Row+n ;------------------------------------------------------------------------------- ; Column+n - Returns the cell ID located a number of columns from cell ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 2 ; Cell$ = Starting cell ID ; Num# = Number of columns from cell ; Syntax examples: (Column+n "B12" 3) = "E12", (Column+n "B12" -1) = "A12" ;------------------------------------------------------------------------------- (defun Column+n (Cell$ Num#) (setq Cell$ (ColumnRow Cell$)) (strcat (Number2Alpha (max 1 (+ (car Cell$) Num#))) (itoa (cadr Cell$))) );defun Column+n ;------------------------------------------------------------------------------- ; rtosr - Used to change a real number into a short real number string ; stripping off all trailing 0's. ; Arguments: 1 ; RealNum~ = Real number to convert to a short string real number ; Returns: ShortReal$ the short string real number value of the real number. ;------------------------------------------------------------------------------- (defun rtosr (RealNum~ / DimZin# ShortReal$) (setq DimZin# (getvar "DIMZIN")) (setvar "DIMZIN" 8) (setq ShortReal$ (rtos RealNum~ 2 8)) (setvar "DIMZIN" DimZin#) ShortReal$ );defun rtosr ;------------------------------------------------------------------------------- ; stor - String number to a real number. ; Arguments: 1 ; Str$ = Number in any string format ; Returns: String number converted to a real number. ;------------------------------------------------------------------------------- (defun stor (Str$ / Feet$ Feet~ Inch$ Inch~ Index# Number~ PlusMinus#) (setq Str$ (vl-string-trim " " Str$)) (while (vl-string-search " " Str$) (setq Str$ (FindReplace Str$ " " " ")) );while (setq Str$ (FindReplace Str$ "- " "-")) (setq Str$ (FindReplace Str$ " -" "-")) (if (= (substr Str$ 1 1) "-") (setq PlusMinus# -1 Str$ (substr Str$ 2)) (setq PlusMinus# 1) );if (if (and (= Str$ "")(= PlusMinus# 1)) (setq Str$ "0") );if (cond ((setq Number~ (distof Str$ 2)));Decimal ((setq Number~ (distof Str$ 4)));Architectural ((setq Index# (vl-string-search "'" Str$)) (setq Feet$ (substr Str$ 1 Index#)) (cond ((setq Feet~ (distof Feet$ 2))) ((setq Feet~ (distof Feet$ 4))) );cond (setq Inch$ (substr Str$ (+ Index# 2))) (cond ((setq Inch~ (distof Inch$ 2))) ((setq Inch~ (distof Inch$ 4))) );cond (if (not (wcmatch Inch$ "*'*")) (cond ((and Feet~ Inch~)(setq Number~ (+ (* (abs Feet~) 12) (abs Inch~)))) (Feet~ (setq Number~ (* (abs Feet~) 12))) (Inch~ (setq Number~ (abs Inch~))) );cond );if );case );cond (if Number~ (setq Number~ (* (abs Number~) PlusMinus#)) );if Number~ );defun stor ;------------------------------------------------------------------------------- ; FindReplace - Returns Str$ with Find$ changed to Replace$ ; Arguments: 3 ; Str$ = Text string ; Find$ = Phrase string to find ; Replace$ = Phrase to replace Find$ with ; Syntax: (FindReplace "TO SCALE" "TO" "NOT TO") = "NOT TO SCALE" ; Returns: Returns Str$ with Find$ changed to Replace$ ;------------------------------------------------------------------------------- (defun FindReplace (Str$ Find$ Replace$ / Len# Num# Start#) (setq Len# (strlen Replace$)) (while (setq Num# (vl-string-search Find$ Str$ Start#)) (setq Str$ (vl-string-subst Replace$ Find$ Str$ Num#) Start# (+ Num# Len#) );setq );while Str$ );defun FindReplace ;------------------------------------------------------------------------------- ; Reference to convert a String into an Integer or a Real Number ;------------------------------------------------------------------------------- ; (atoi "7.5") = 7 [ string to integer ] ; (atof "7.5") = 7.5 [ string to real ] ; (stor "7 1/2") = 7.5 [ string to real ] ; Add other conversions here. ;------------------------------------------------------------------------------- (princ);End of GetExcel.lsp DwgProp.DCL Quote
pkenewell Posted November 16, 2022 Posted November 16, 2022 (edited) On 11/1/2022 at 3:35 PM, Rayan Lobo said: I found an AutoLISP program in forums. It works partially. Its supposed to create 2 commands 1. DwgPropExp --> Exports the attributes from drawing properties to a .prp file 2. DwgPropImp--> Imports the attributes from .prp file to drawing properties The first (DwgPropExp) works properly but autocad gives an error when executing the second (DwgPropImp) I don't get the title. The program you are showing here has nothing to do with getting anything from Excel. It saves the properties to a custom ASCII file and reimports them from the same file. Edited November 16, 2022 by pkenewell Quote
rlx Posted November 16, 2022 Posted November 16, 2022 ;;; I found an AutoLISP program in forums. It works partially. ;;; Its supposed to create 2 commands ;;; 1. DwgPropExp --> Exports the attributes from drawing properties to a .prp file ;;; 2. DwgPropImp--> Imports the attributes from .prp file to drawing properties ;;; The first (DwgPropExp) works properly but autocad gives an error when executing the second (DwgPropImp) ;;; Would appreciate it if someone could help me resolve it since i've just started learning AutoLISP ;;; Below is the code: ;;; C:\Program Files\DSA\ACAD Tools\DwgProp.LSP;; Properties Import / Export / Utilities ;;; by Irn� Barnard ;;; Setup global variables (setq iPropStanList (list "DWGNAME" "Title" "Subject" "Author" "Keywords" "Comments" "RevisionNumber" "HyperlinkBase" "LastSavedBy") iPropStandard (length iPropStanList) ;Number of standard properties at start of list ) ;_ end of setq (vl-load-com) ;; Function to return the properties from the current drawing (defun GetDwgProps (si / lst) ;Get all standard drawing properties (setq lst (list (vl-list* "DWGNAME" (strcat (getvar "DWGPREFIX") (getvar "DWGNAME"))) ;Store original drawing name (vl-list* "Title" (vla-get-title si)) ;Get Title property (vl-list* "Subject" (vla-get-subject si)) ;Get Subject property (vl-list* "Author" (vla-get-author si)) ;Get Author property (vl-list* "Keywords" (vla-get-keywords si)) ;Get Keywords property (vl-list* "Comments" (vla-get-comments si)) ;Get Comments property (vl-list* "RevisionNumber" (vla-get-revisionnumber si)) ;Get RevisionNumber property (vl-list* "HyperlinkBase" (vla-get-hyperlinkbase si)) ;Get HyperlinkBase property (vl-list* "LastSavedBy" (vla-get-lastsavedby si)) ;Get LastSavedBy property ) ) ;Get all custom drawing properties (setq n (1- (vlax-invoke-method si 'NumCustomInfo))) ;Set counter to 0 & get number of custom properties (while (>= n 0) ;Step through all custom properties (vlax-invoke-method si 'GetCustomByIndex n 'pname 'pdata) ;Get custom property number n (setq lst (append lst (list (vl-list* pname pdata)))) ;Append to list (setq n (1- n)) ) lst ;Return new list ) ;End of GetDwgProps ;; Export Drawing Properties (defun c:DwgPropExp (/ fn doc db si fid lst n pname pdata) ;;; Get default filename (excl. extension) & path from current drawing name (setq fn (strcat (getvar "DWGPREFIX") (vl-filename-base (getvar "DWGNAME")) ".PRP")) (if (setq fn (getfiled "DwgProp Save" fn "prp" 1)) ;Let user select filename (progn (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))) ;get vl object for current drawing (setq db (vla-get-Database doc)) ;get vl object for drawing db (setq si (vla-get-SummaryInfo db)) ;get vl object for drawing properties (setq lst (GetDwgProps si)) ;get current drawing's properties ;;; open / create file for saving properties & save list to file (setq fid (open fn "w") pname (length lst) n 0) (while (< n pname) ;step through list (setq pdata (nth n lst)) ;get nth element of list (print pdata fid) ;write the current list item to the file (setq n (1+ n)) ) (close fid) (princ (strcat "Finished exporting drawing properties to [" fn "].")) ) (princ "Export drawing properties - Canceled by user.") ) (princ) ) ;; Import Drawing Properties (defun c:DwgPropImp (/ fn fid lst line doc db si lst0 lst1 lst2 lstp n str sellst1 sellst2 DwgProp-fn DwgProp-fp dcl_id) ;;; Get default filename from current drawing name , get path to current drawing (setq fn (strcat (getvar "DWGPREFIX") (vl-filename-base (getvar "DWGNAME")) ".PRP")) ;;; Let user select filename (if (setq fn (getfiled "DwgProp Open" fn "prp" 0)) (progn ;;; Open File for reading (setq fid (open fn "r") lst (list)) ;;; Read lines from file (while (setq line (read-line fid)) (setq lst (cons (read line) lst))) ;;; Close the file (close fid) ;;; Reverse list (setq lst (cdr (reverse lst))) ;;; get vl object for current drawing (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))) ;;; get vl object for drawing db (setq db (vla-get-Database doc)) ;;; get vl object for drawing properties (setq si (vla-get-SummaryInfo db)) ;;; get current drawing's properties (setq lst0 (GetDwgProps si)) ;;; Function to check if custom propery already exists (defun is-custom-p (si name / n ret pname pdata pcount) (setq ret nil n 0 pcount (vlax-invoke-method si 'NumCustomInfo)) (while (and (< n pcount) (not ret)) (vlax-invoke-method si 'GetCustomByIndex n 'pname 'pdata) (if (= pname name) (setq ret n) (setq n (1+ n))) ) ret ) ;;; Function to toggle ignore / import / delete (defun togle-import (opt / act n lstname str1 sellst srclst) (cond ((= opt 0) (setq act "N")) ((= opt 1) (setq act "Y")) ((= opt 2) (setq act "D")) ((= opt 3) (setq act "N")) ) (if (> opt 1) (setq lstname "LstOld" sellst sellst2 srclst lst0) ;Set deleted values (setq lstname "LstNew" sellst sellst1 srclst lst ) ;Set import / ignore values ) ;; Step through selected list (setq n 0) (while (< n (length sellst)) (if (or (/= opt 2) (>= (nth n sellst) (1- iPropStandard))) (progn (start_list lstname 1 (nth n sellst)) ;Start editing list at index from selected list (add_list (strcat act " = " (car (nth (1+ (nth n sellst)) srclst)))) ;Set new prefix (end_list) ) ) (cond ;;; get current drawing's properties ((= opt 0) x (setq lst1 (subst (vl-list* (car (nth (1+ (nth n sellst)) srclst)) nil) (assoc (car (nth (1+ (nth n sellst)) srclst)) lst1) lst1))) ;;; Set imported list items ((= opt 1) (setq lst1 (subst (vl-list* (car (nth (1+ (nth n sellst)) srclst)) T) (assoc (car (nth (1+ (nth n sellst)) srclst)) lst1) lst1))) ;;; Set deleted list items ((and (= opt 2) (>= (1+ (nth n sellst)) iPropStandard)) (setq lst2 (subst (vl-list* (car (nth (1+ (nth n sellst)) srclst)) T) (assoc (car (nth (1+ (nth n sellst)) srclst)) lst2) lst2))) ;;; Set non-deleted list items ((= opt 3) (setq lst2 (subst (vl-list* (car (nth (1+ (nth n sellst)) srclst)) nil) (assoc (car (nth (1+ (nth n sellst)) srclst)) lst2) lst2))) ) ;;; end cond (setq n (1+ n)) ) ) ;End of defun togle-import ;;; Function to check selection for similarities (defun update-list ( OldNew val lst / str1 newstr n lst) (setq str1 (vl-string-right-trim " \t\n" (vl-string-left-trim " \t\n" val)) newstr nil) ;Init variables (if (= OldNew 0) ;| Init old selected list |; (setq sellst2 nil) ;| Init new selected list |; (setq sellst1 nil) ) ;;; Step through string until all numbers removed (while (> (strlen str1) 0) ;;; Get 1st number in string (setq n (read str1)) ;;; Check if value differs (if (and newstr (/= newstr (cdr (nth (1+ n) lst)))) ;;; Set value to show that it differs (setq newstr "*VARIES*") ;;; Else if the string hasn't been assigned yet , et string to show value (if (not newstr) (setq newstr (cdr (nth (1+ n) lst)))) ) ;;; Remove 1st number from string (setq str1 (vl-string-left-trim " \t\n" (substr str1 (1+ (strlen (itoa n)))))) (if (= OldNew 0) (setq sellst2 (cons n sellst2)) ;Add number to old selected list (setq sellst1 (cons n sellst1)) ;Add number to new selected list ) ) (if (= OldNew 0) (set_tile "ValOld" newstr) ;Show value string in ValOld edit field (set_tile "ValNew" newstr) ;Else show value string in ValNew edit field ) ) ;End of defun update-list ;; Open dialog & initialize values (DwgProp_Write_Dialog) (cond ((not (setq dcl (findfile DwgProp-fn))) (princ "Computer says no : unable to create dialog file")) ((not (setq dcl_id (load_dialog dcl))) (princ "Computer says no : unable to load dialog file")) ((not (new_dialog "PropImport" dcl_id)) (princ "Computer says no : unable to start dialog")) (t ;;; Set edit box value of prev drawing name (set_tile "txtDescr" (strcat "Select those properties you want to import. By default all standard properties will not be imported, " "while all custom properties will. Prefix Key: Y=Import; N=Ignore; D=Delete")) (set_tile "PrevDWG" (cdr (assoc "DWGNAME" lst))) ;;; Initialize list variables (setq lst1 nil lst2 nil lstp nil) ;;; Load new values into listbox ;;; Start editing list (start_list "LstNew" 3) ;;; Start loading list from 2nd item (1st is DWG Name) (setq n 1) (while (< n (length lst)) ;;; Check if list item is standard property (if (< n iPropStandard) ;;; Set to ignore & add to changed / added list not marked for import (setq str "N" lst1 (cons (vl-list* (car (nth n lst)) nil) lst1)) ;;;Else set to import & add to changed / added list marked for import (setq str "Y" lst1 (cons (vl-list* (car (nth n lst)) T) lst1)) ) ;;; Get nth item from list (setq str (strcat str " = " (car (nth n lst)))) ;;; ;Add to listbox (add_list str) (setq n (1+ n)) ) ;;; Close list editing (end_list) ;;; Load current values into listbox ;;; Start editing list (start_list "LstOld" 3) ;;; Start loading list from 2nd item (1st is DWG Name) (setq n 1) (while (< n (length lst0)) (setq str (strcat "N = " (car (nth n lst0)))) ;Get nth item from list (add_list str) ;Add to listbox (setq lst2 (cons (vl-list* (car (nth n lst0)) nil) lst2)) ;Add to delete list not marked for delete (setq n (1+ n)) ) (end_list) ;Close list editing (action_tile "LstNew" "(update-list 1 $value lst)") ;Set action for selection update of new list (action_tile "LstOld" "(update-list 0 $value lst0)") ;Set action for selection update of old list (action_tile "btnIgn" "(togle-import 0)") ;Set action for ignore button (action_tile "btnImp" "(togle-import 1)") ;Set action for import button (action_tile "btnDel" "(togle-import 2)") ;Set action for delete button (action_tile "btnDNo" "(togle-import 3)") ;Set action for delete button ;;; fn fid lst line doc db si dcl_id lst0 lst1 lst2 lstp sellst1 sellst2 ;;; Display the dialog (if (= 1 (start_dialog)) ;;; if OK start import (progn ;;; Delete custom properties marked for deletion (setq n 0) (while (< n (length lst2)) (setq str (car (nth n lst2))) (if (and (not (vl-position str iPropStanList)) (cdr (nth n lst2))) (vlax-invoke-method si "RemoveCustomByKey" str)) (setq n (1+ n)) ) ;;; Import values marked for import (setq n 0) (while (< n (length lst1)) ;;; Check if standard property (setq str (car (nth n lst1)) lstp (assoc str lst)) ;;; Set standard property (if (vl-position str iPropStanList) (vlax-put-property si str (cdr lstp))) ;;; Else Check if custom key exists (if (assoc str lst0) (vlax-invoke-method si "SetCustomByKey" str (cdr lstp)) ;Change custom key's value (vlax-invoke-method si "AddCustomInfo" str (cdr lstp)) ;Else add custom key ) (setq n (1+ n)) ) ) ) ) ) (princ (strcat "Finished importing drawing properties from [" fn "]." )) ) ;;; end progn select filename (princ "Import drawing properties - Canceled by user.") ) ;;; end if user select filename ;;; clean up (if dcl_id (unload_dialog dcl_id)) (if DwgProp-fp (close DwgProp-fp)) (if (and DwgProp-fn (findfile DwgProp-fn))(vl-file-delete (findfile DwgProp-fn))) (princ) ) (defun DwgProp_Write_Dialog ( ) (if (and (setq DwgProp-fn (vl-filename-mktemp "DwgProp.dcl")) (setq DwgProp-fp (open DwgProp-fn "w"))) (mapcar '(lambda (x)(write-line x DwgProp-fp)) (list "// Dialogs for drawing property utilities" "// by Irné Barnard" "" "PropImport : dialog {" " label = \"Import Drawing Properties\";" " : row {" " : edit_box {" " label = \"Previous DWG\";" " key = \"PrevDWG\";" " value = \"\";" " is_enabled = false;" " allow_accept = false;" " }" " }" " : row {" " : column {" " : list_box {" " label = \"New Properties\";" " key = \"LstNew\";" " multiple_select = true;" " width = 20;" " height = 20;" " value = \"\";" " }" " : row {" " : button {" " label = \"Set Import\";" " key = \"btnImp\";" " width = 9;" " }" " : button {" " label = \"Set Ignore\";" " key = \"btnIgn\";" " }" " }" " }" " : column {" " : list_box {" " label = \"Old Properties\";" " key = \"LstOld\";" " multiple_select = true;" " width = 20;" " height = 20;" " value = \"\";" " }" " : row {" " : button {" " label = \"Set Delete\";" " key = \"btnDel\";" " }" " : button {" " label = \"Set Not Delete\";" " key = \"btnDNo\";" " }" " }" " }" " : column {" " : text { label = \"New Value\"; }" " : text {" " key = \"ValNew\";" " value = \"\";" " width = 20;" " height = 10;" " }" " spacer;" " : text { label = \"Current Value\"; }" " : text {" " key = \"ValOld\";" " value = \"\";" " width = 20;" " height = 10;" " }" " }" " }" " : row {" " : text {" " width = 40;" " height = 3;" " key = \"txtDescr\";" " }" " ok_cancel;" " }" "}" ) ) ) (if DwgProp-fp (close DwgProp-fp)) ) (defun c:t1 ()(c:DwgPropExp)) (defun c:t2 ()(c:DwgPropImp)) Quote
Rayan Lobo Posted November 16, 2022 Author Posted November 16, 2022 @pkenewell Hi The way I'm looking at it is an indirect link. The .prp file can be opened in Excel as a delimited file and can be saved in the same way. By doing that data from another excel can simply be copied and pasted and the .prp file can be saved as is with the new data which can then be imported into AutoCAD Quote
pkenewell Posted November 16, 2022 Posted November 16, 2022 1 minute ago, Rayan Lobo said: @pkenewell Hi The way I'm looking at it is an indirect link. The .prp file can be opened in Excel as a delimited file and can be saved in the same way. By doing that data from another excel can simply be copied and pasted and the .prp file can be saved as is with the new data which can then be imported into AutoCAD @Rayan Lobo OK Understood. The "GetExcel" functions you posted would not help you then, because they are for direct manipulation of XLSX files, not delimited text files. In the post above, @rlx imbedded the DCL file for you so the Lisp program can run on it's own. Quote
DATVO Posted 6 hours ago Posted 6 hours ago You can refer to this tool — I find it handles large file volumes well and even provides a report file. https://lispautocad.gumroad.com/l/rnyiew Quote
DATVO Posted 6 hours ago Posted 6 hours ago You can refer to this tool — I find it handles large file volumes well and even provides a report file. https://lispautocad.gumroad.com/l/rnyiew Quote
Recommended Posts
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.