Jump to content

Leaderboard

  1. Lee Mac

    Lee Mac

    Trusted Member


    • Points

      16

    • Posts

      21,057


  2. GLAVCVS

    GLAVCVS

    Community Member


    • Points

      15

    • Posts

      785


  3. Steven P

    Steven P

    Trusted Member


    • Points

      10

    • Posts

      2,894


  4. mhupp

    mhupp

    Trusted Member


    • Points

      9

    • Posts

      2,065


Popular Content

Showing content with the highest reputation since 10/08/2025 in all areas

  1. I did write something once to find and launch documents but its a little over the top probably. But Bigal also had a good suggestion , a program called everything.
    3 points
  2. @Steven P See what this does. again will use default browser. (startapp "explorer.exe" "https://www.youtube.com/watch?v=dQw4w9WgXcQ") So above can be (defun c:GetGoogle ( / Search Page) (setq Search (getstring "Enter Serch Term: [use '+' between terms] ")) ;; get search term, '+' between words (setq Page (strcat "https://www.google.com/search?q=" Search)) ;; google + search term address (startapp "explorer.exe" page) ) -edit didn't have the exe
    3 points
  3. actually quite nice Steven , think I'm gonna add this to one of my toolbars (if there's still room that is...) for opening things I also like : https://lee-mac.com/open.html
    3 points
  4. also shell commands - I've only used that once though: (defun c:GetGoogle ( / SearchTerm PageBase) (setq SearchTerm (getstring "Enter Serch Term: [use '+' between terms] ")) ;; get search term, '+' between words (setq PageBase "(command \"shell\" \"start microsoft-edge:http://google.com/search?q=") ;; google address (setq Page (strcat PageBase SearchTerm "\")" )) ;; google + search term address (eval (read Page)) ;; open 'Page' ) Guess what this does....
    3 points
  5. Even more reason to give weight to the opinions of those who have more experience in this area To the man with a hammer, everything looks like a nail.
    3 points
  6. I think it's time you started to learn AutoLISP @Nikon
    3 points
  7. Here's a proof-of-concept example for consideration - (defun update-attributes ( / bln idx ins map obj sel tag val ) (setq ;; List of ;; ((lower-left point) (upper-right point) "attribute value") map '( (( 0.0 0.0) (10.0 10.0) "abc") ((20.0 20.0) (30.0 30.0) "def") ) ;; Block name bln "YourBlock" tag "YourTag" ) (setq bln (strcase bln) tag (strcase tag) ) (if (setq sel (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," bln))))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) obj (vlax-ename->vla-object (ssname sel idx)) ) (cond ( (/= bln (strcase (vlax-get-property obj (if (vlax-property-available-p obj 'effectivename) 'effectivename 'name))))) ( (setq ins (vlax-get obj 'insertionpoint) val (vl-some '(lambda ( itm ) (if (vl-every '<= (car itm) ins (cadr itm)) (caddr itm))) map) ) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (progn (if (vlax-write-enabled-p att) (vla-put-textstring att val) ) t ) ) ) (vlax-invoke obj 'getattributes) ) ) ) ) ) ) (defun block-position-callback ( rtr arg ) (if (and arg (wcmatch (strcase (car arg) t) "qsave,save,saveas,plot,publish")) (update-attributes) ) (princ) ) ( (lambda ( key ) (vl-load-com) (foreach rtr (cdar (vlr-reactors :vlr-command-reactor)) (if (= key (vlr-data rtr)) (vlr-remove rtr) ) ) (vlr-set-notification (vlr-command-reactor key '( (:vlr-commandwillstart . block-position-callback) ) ) 'active-document-only ) (update-attributes) (princ) ) "block-position-reactor" ) There is no command to run the program: simply amend the block name, tag name, and map at the top of the code to suit your setup, and then load the program - the attributes will be automatically updated when the drawing is saved or plotted.
    2 points
  8. I use Everything all the time it indexes hard drives and finds a file instantly. Re Access, Word, Excel and Libre office all of these can be accessed from CAD I use Bricscad. You can for say Access not only open but actually get at the data, most common being Excel get and put. If you have a few known files you want to open all the time can either make a defun for each and load on startup or my preferred would be a sub menu in a POP menu with the file names as the description. As mentioned already using notepad is shown how in ACAD.PGP as an already defined option.
    2 points
  9. Didn't have the exe in the startapp line so maybe thats why?
    2 points
  10. This will search a location for a file type, in the example searching for LISP files in c:\MyLocation\Here - remember to use a double backslash in any location, and return a list of files names + extensions (also folders if the file type is *.*). (setq myfiles (vl-directory-files "C:\\MyLocation\\Here" "*.lsp" nil)) You could do a search of this list to check if your required file is in there As MHUPP use startapp to open the file, here opens the file in variable Lispfile with notepad (startapp "notepad" Lispfile) MHUPP example was for explorer - I didn't know that method would work for any file type to open the default programme. For the first line here, your file path could be contained in a list, looping through each list item (location) until you find the file you want - could search a few locations if you knew them and want to hardcode them in the LISP, and if fails to find them there use MHUPPs 'getfiled' line for the user to select a folder or file. Use an if, cond or while loop to open the file where it finds it and stop the rest of the loop from looping
    2 points
  11. Had a command DIR to start in the folder of the active drawing would open the save prompt like window to allow you to select the file you want. pretty sure if you feed the path to explorer it will use the default program to open the file. (defun C:DIR ( / filePath) (setq dwgPath (getvar "DWGPREFIX")) (setq filePath (getfiled "Select a File to Open" dwgPath "*" 0)) ;limit what types you see by changing "*" (if filePath (progn (startapp "explorer.exe" filePath) (princ (strcat "\nOpening: " filePath)) ) (princ "\nNo file selected.") ) (princ) ) -edit You can also hard code where it stats in like if your documents are in a network drive. (setq filePath (getfiled "Select a Spec File" "C:\\Project\\spec\\" "PDF" 0)) ;look in spec folder for all pdf's
    2 points
  12. Oh I'm not mad, I just think you're blinkered into using the Startup Suite. As I've suggested throughout this thread, I would use the acaddoc.lsp. In my acaddoc.lsp, I have the following basic code: ( (lambda ( d ) (foreach x (vl-directory-files d "*.lsp" 1) (if (/= "acaddoc.lsp" (strcase x t)) (load (strcat d "\\" x) nil) ) ) ) "C:\\YourLISPFolder" ) Then, whatever .lsp files I place in "C:\\YourLISPFolder" are automatically loaded on startup - no need to change the Startup Suite, no need to modify the acaddoc.lsp any further - just drop a file into the folder.
    2 points
  13. @Nikon My 2c .. place all your lisp files in a subfolder under "MYDOCUMENTS". Then you don't have to worry about permissions, AutoCAD version or usernames. (strcat (getvar "MYDOCUMENTSPREFIX") "\\LISP") Then add this to your support paths and DONE!
    2 points
  14. You can enable VLIDE in newer releases by setting LISPSYS=0. https://help.autodesk.com/view/ACD/2024/ENU/?guid=GUID-1853092D-6E6D-4A06-8956-AD2C3DF203A3
    2 points
  15. I'm still not understanding why this won't do the trick. I've been successfully loading files for 20+ years using a version of that code and a custom MNL tied to a partial CUI. Adding a bunch of lisp routines to the startup suite is not standard practice ( well at least in my little world : ) )
    2 points
  16. Mmm I forgot something very important: the convention When typing any file name, you must replace the . with @ For example: if you want to open "acad.lsp," you would type "acad@lsp"
    1 point
  17. (defun c:**r** nil (if averigua (progn (vlr-remove **a**) (setq **a** nil averigua nil) (princ "Open-file Command-line DEACTIVATED");"SensiCMD DESACTIVADO") ) (progn (setq **a** (vlr-command-reactor "***" '((:vlr-unknowncommand . averigua)))) (defun averigua (a b / c) (if (setq c (findfile (vl-string-subst "." "@" (car b)))) ;;; (decodifica c) (LM:open c) ) ) (princ "Open-file Command-line ACTIVATED");"SensiCMD ACTIVADO") ) ) (princ) ) Here you go. Copy this code into the acad*.lsp file where you save your custom lisps. Once loaded, you can enable or disable the included code by typing the **r** command. I assume you've downloaded Lee Mac's code (LM:open). It's perfect for what you need, so I've included a call to "LM:open," but you'll have to add the code for this function yourself. As for the **r** command, when the included code is enabled, anything you type on the command line that matches the name of a file found in any of AutoCAD's "SupportPaths," "LM:open" will open it with the default Windows application. This will happen without any command being executed To disable the code, just run **r** again. PS: When typing any file name, you must replace the . with @ Example: to "acad.lsp" type "acad@lsp" I hope it's useful
    1 point
  18. Thanks Jerry and BigAl, The main use I have for this one is when I want to edit a LISP file - pop up dialogue to select the routine, open the file in notepad, 'Find' which usually takes me to the LISP name in the file. The find dialogue all happens without me needing to press any buttons. BIgAl - handy but in this case I know the file name and location to go straight to it - handy later in life if I don't know what file I want though, thanks MHUPP - going to look into that this morning, saving the answer into my "make windows work right" file Undoing the alias as in the link was the trick (Start Menu - settings - Apps - Advanced App Settings - Alias), pinned the proper notepad to the task bar (not the new one, located in c:\windows\notepad.exe or c:\windows\system32\notepad32.exe), now to set the proper notepad as the default as it should be.
    1 point
  19. in windows 11 they have two notepads now. think you will have to remove the app one to go back to the classic one. https://www.dedoimedo.com/computers/windows-11-notepad-classic.html
    1 point
  20. Nice, I was thinking AcFdFieldReactor because it has all those plus REGEN, but it’s not available to lisp. You might add REGEN to the list, so the user can see the updated values without needing to save or plot.
    1 point
  21. The issue is CAD literacy within the office. One of my engineers would be fine to use it, but the rest are fairly CAD illiterate. I try to keep things as simple as possible (I know running a lisp command is simple to begin with)
    1 point
  22. @PGia In case you don't mind including all the file locations you need to reference in AutoCAD's "SupportPaths" (other external paths could also be considered, but would require more code), there is another option, unorthodox but disruptive: type the name of the file to open directly into the command line (but with a small convention) I think some of the participants in this thread know what I'm talking about. If not, I'll explain it with a little code when I get home.
    1 point
  23. Don't create a new reactor for every object - this is likely to severely impact performance - only one object reactor is required with a set of owning objects. Aside, you're missing the definition for your (let*) function.
    1 point
  24. Thanks for the answers. They're really very interesting. And I really liked @Steven P's Lisp for searching on Google In response to Ciberangel, I must say that I often need to edit acad.lsp and other AutoCAD support files, and I really feel like I'm wasting a lot of time doing that. Additionally, I almost always need to open Access databases that contain information related to the drawings I manage. I also manage photo banks with standardized names that I need to reference on the fly in my drawings. For these reasons, a tool to search and open these files will save me a lot of time.
    1 point
  25. Didn't quite work for me - opened explorer and went to a folder - not sure why yet ... actually, take away the '/watch?v....." and it works, probably just your dodgy youtube viewing habits..
    1 point
  26. If it's not exclusively AutoCAD files, you may be better off using a system tool. What kinds of files would you be looking for? What parameters would you be searching with? What editors would you be opening them with? The more you can tell us, the better we can help you.
    1 point
  27. Another... https://forums.augi.com/showthread.php?170434-MText-width-set-to-zero&s=8d83700e43971c18c05d195f56cd176a&p=1330953&viewfull=1#post1330953
    1 point
  28. Good day everyone! I want to add several lisp files to the startup at once. I have a list of lisp files in notepad, in the Support folder. The code returns an error: no function definition: VLA-GET-STARTUPSUITE (defun c:add-list-lisps-to-startup ( / file line folder fullpath app ssuite ) (vl-load-com) ;; The folder where the LISP files are located (setq folder "C:/Program Files/Autodesk/AutoCAD 2021/Support/") ;; Opening the list file (setq file (open "C:/Program Files/Autodesk/AutoCAD 2021/Support/list_startup.txt" "r")) (if file (progn ;; Getting the object Application (setq app (vlax-get-acad-object)) (setq ssuite (vla-get-StartupSuite app)) (while (setq line (read-line file)) (setq line (vl-string-trim " \t\r " line)) (if (and line (> (strlen line) 0)) (progn (setq fullpath (strcat folder line)) (if (findfile fullpath) (progn (vla-Add ssuite fullpath) (princ (strcat "Added to auto-upload: " fullpath)) ) (princ (strcat "File not found: " fullpath)) ) ) ) ) ; end while (close file) (princ "All files from the list have been processed.") ) ; end progn (princ "Couldn't open the list file.") ) ; end if (princ) ) ; end defun
    1 point
  29. Not quite what you want but I have this line on opening a file: (setvar "MTEXTCOLUMN" 0) ;;Dynamic columns OFF Just in case someone has been using columns. Just a setting, won't alter existing texts Might be an edit - have a memory of making something up EDIT: Strip MText (SMT) clears columns... need to look at how
    1 point
  30. If I understand correctly, you can't do this with standard AutoCAD tools. You need to associate each label with its perimeter and its neighboring boundary. To do this, you'll need to break each perimeter down into individual polylines. Each perimeter section shared by two labels must be a separate polyline. Start by figuring out how to achieve this.
    1 point
  31. If I understand the question, you want to use the stationing as part of a text label and as part of a title block. One way to do that is to define a custom property as one of your drawing properties. Set it to that text. Include the field in your text and in your title block. When you change the property, the field automatically updates with the new value.
    1 point
  32. @Nikon You should copy the code again. I didn't paste the code correctly. Also, I've also modified something.
    1 point
  33. Why not use the acaddoc.lsp instead?
    1 point
  34. And what does it do? The same as the previous command BUT ALSO: – it writes into 'acad.lsp' Lisp code to load, from the next startup onward, the file 'ListaLisps.lsp', which in turn calls the loading of all the Lisp files in the selected folder. – adds the location of the files to AutoCAD’s 'SupportPath'.
    1 point
  35. Maybe this will do what you need. (defun c:LoadFolder (/ sh hwd carp slf pth lstAA a arch nmarch nmarchLL cno cns sl r l) (setq sl (getvar "SECURELOAD")) (SETVAR "SECURELOAD" 0) (if (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "shell.application") hwd (vl-catch-all-apply 'vla-get-hwnd (list (vlax-get-acad-object))) carp (vlax-invoke-method sh 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) "Folder to load" 0 "") ) (if (setq slf (vlax-get-property carp 'self) pth (vlax-get-property slf 'path) pth (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth)) ) (if (setq lstAA (vl-directory-files pth "*.lsp")) (foreach a lstAA (if (not arch) (setq arch (open (setq nmarchLL (strcase (strcat (VL-REGISTRY-READ "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders" "Personal" ) "\\ListaLisps.lsp" ) ) ) "w" ) ) ) (load (strcat (setq cno (strcat pth "\\" a)))) ;;; (princ (strcat "\n" cno "... *** LOADED ***")) (write-line (strcat "(load \"" cno "\")") arch) ) ) ) ) (if arch (progn (close arch) ;;;;;; (startapp "notepad" nmarch) (princ (strcat "\n*** " (itoa (length lstAA)) " files LOADED ***")) (if (not (wcmatch (strcase pth) (setq cns (VLAX-get-property (setq prf (VLAX-get-property (vla-get-preferences (vlax-get-acad-object)) "files")) "SupportPath")))) (progn (vlax-put prf "SupportPath" (strcat cns ";" pth)) (princ (strcat "\n*** New SupportPath: " pth)) ) ) (setq nmarch (if (setq a (findfile "acad.lsp")) a (strcat (vl-filename-directory (findfile "acad.exe")) "\\Support\\acad.lsp"))) (if a (if (setq arch (open nmarch "r")) (progn (while (and (not r) (setq l (read-line arch))) (setq r (wcmatch (strcase l) "(LOAD *LISTALISPS.LSP\")" ))) (close arch)) (alert (princ (strcat "It was not possible to write to \"acad.lsp\". Open the file yourself and write: (load \"" nmarchLL "\")"))) ) ) (cond ((and a (not r)) (if (setq arch (open nmarch "a")) (progn (write-line (strcat "(load \"" nmarchLL "\")") arch) (close arch))) ) (a (princ) ) ;;; (nmarch (if (setq arch (open nmarch "w")) (progn (write-line "(LOAD \"LISTALISPS.LSP\")" arch) (close arch)))) (nmarch (if (setq arch (open nmarch "w")) (progn (write-line (strcat "(load \"" nmarchLL "\")") arch) (close arch)))) (T (alert "Ocurrió lo inesperado")) ) (startapp "notepad" nmarch) ) ) (SETVAR "SECURELOAD" sl) (princ) )
    1 point
  36. Are all your files in the same folder - my startup suit can select multiple files in the same folder. Takes time if they are in different folders. I did see a way to amend the startup suit files using the registry settings but paused that idea - I think it was too much dependant on versions and your profile to make it any use but me I used to add all my files to the startup suit, but eventually that slows loading a CAD file as it loads everything. Now I load the 3 or 4 LISP files that I use all the time and load on demand the rest. If the files are in a trusted location use AutoLoad from BigAl. Mine arn't (on purpose - saved on the network), otherwise I use something like this: (defun c:MyLisp () (load "C:/Location/MyLISPs.LSP") (c:MyLisp) (princ)) One line for each command you might use - a bit of effort to list all the LISPs if you are doing them all at once, not so bad if you add to the list with each new LISP. This is saved in a LISP file which is added to the startup suit. Call the LISP, if it isn't loaded then it runs the above line, loads the file, runs the LISP. Or you can go with GLAVCVS idea, use your list of LISP files and for each file (load "C:/Location/MyLISPs.LSP") saved into a LISP file added to startup. No need for a Defun just these lines so they autorun and load the files. This should give you a listing of files: Where FPath is the file path (remember double backslash) and searchterm can be used to filter by filename, can use wildcards, * for any character (example blk* for any lisp file beginning with blk) (defun GetBLKFiles2 ( FPath searchterm / BLKFiles) (setq searchterm (strcat searchterm ".lsp")) (setq BLKFiles (vl-directory-files FPath searchterm)) BLKFiles )
    1 point
  37. @BIGAL's option is a very good one. Regarding your question about writing the LISPs to load to a file, the code can be easily adapted to that. But I think it would take the same amount of time as writing it to a file: - Option 1: Write the names of the LISPs to load to a file: find the file name in the folder, write the file name, and then correct 5% of the names (statistically, I think you'd write 5% of the names with some kind of error. That will waste your time later trying to figure out what's wrong and correcting the file). ESTIMATED AVERAGE TIME (my own) FOR ALL THIS: 15 seconds per file - Option 2: Select each file to copy in Windows Explorer, Control+C, find the destination folder, Control+V, and then Windows should take about 5 seconds to complete this task. ESTIMATED TIME (my estimate) FOR ALL OF THIS: LESS THAN 10 SECONDS PER FILE. Based on this, for me, the choice is clear. But if you're sure you prefer the file option, then just open (or create, if you don't have one) the "acad. lsp" file and write a line like this for each file you want to load: (load "filename.lsp") PS In the latter case, you will need to include the location of your lisp files in the AutoCAD search paths list.
    1 point
  38. Why not use a pop menu a toolbar or a ribbon then all your lisps are available. This has 130 lisp's behind it. You can check if loaded already else load it.
    1 point
  39. @Nikon You should try what I posted. It will LOAD not AUTOLOAD all lisp files found within the folder "C:\\Program Files\\Autodesk\\AutoCAD 2021\\Support\\"
    1 point
  40. PS The idea has more substance than the code itself
    1 point
  41. A code as simple as this... (defun c:LoadFolder (/ sh hwd carp slf pth lstAA a) (if (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "shell.application") hwd (vl-catch-all-apply 'vla-get-hwnd (list (vlax-get-acad-object))) carp (vlax-invoke-method sh 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) "Folder lisp to load" 0 "") ) (if (setq slf (vlax-get-property carp 'self) pth (vlax-get-property slf 'path) pth (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth)) ) (if (setq lstAA (vl-directory-files pth "*.lsp")) (foreach a lstAA (load (strcat pth "\\" a)) ) (alert "Nothing to load") ) ) ) (princ) )
    1 point
  42. Yes I think you should learn these simple things. In any case, in situations like this, one way to avoid having to select the 50 lisp files one by one or, in the future, any group of files you need to load, is to create folders where you group and store the lisps needed for each task. For example: you can create a folder called "Print", in which you store all your lisp files that you use to prepare a drawing for printing. In this way, you would only need to create a command (for example "LoadFolder") that shows you a "dialogBox" to select the folder and load all its contents.
    1 point
  43. Agree with Lee look into lisp built in functions, if you use Autoload function then its easy just need to add one lisp to the Start Up Suite. An example of the lsp file. (autoload "COPY0" '("COPY0")) (autoload "COPYCOMMAND" '("ZZZ")) (autoload "COVER" '("COVER")) (autoload "DIMFLIP" '("DIMFLIP")) (autoload "DRAWXFALL" '("DRAWXFALL")) (autoload "DRAWPIPE" '("DRAWPIPE")) ..... add more
    1 point
  44. Try Lee Mac's "List Duplicates" functions at the following link: https://www.lee-mac.com/uniqueduplicate.html#listdupes
    1 point
  45. ;BACALADO DE BILBADOOO (PLUS) (defun nqf (tuSS / i lista tipObj cant cad txs atts) (princ "\nNumero que falta") (terpri) (if tuSS (setq cant (sslength tuSS)) (progn (alert "No existe conjunto de seleccion o esta vacio") (exit) ) ) (princ "\nCantidad de textos seleccionados = ") (princ cant) (princ "\nLista de numeros faltantes") ;Pasar del SS a una lista de valores (setq i 0 txs 0 atts 0) (repeat (sslength tuSS) (setq tipObj (cdr (assoc 0 (setq le (entget (ssname tuSS i))))) num (atoi (cdr (assoc (if (= tipObj "TEXT") 1 2) le))) i (1+ i) lista (if (setq l (assoc num lista)) (subst (list num (1+ (cadr l))) l lista) (append lista (list (list num 1))) ) ) (if (= tipObj "TEXT") (setq txs (+ txs 1)) (setq atts (+ atts 1))) ) ;Imprimir los valores que no aparezcan (terpri) (setq i 1) (princ (strcat "\nLista de numeros existentes\n" (while lista (if (setq v (assoc i lista)) (setq cad (if (= (cadr v) 1) (if cad (strcat cad ", " (itoa (car v))) (itoa (car v)) ) (if cad (strcat cad ", " (itoa (car v)) "(" (itoa (cadr v)) ")") (strcat (itoa (car v)) "(" (itoa (cadr v)) ")") ) ) lista (vl-remove v lista) ) (princ (strcat "\nFalta el # " (itoa i))) ) (setq i (1+ i)) cad ) "\nTextos: " (itoa txs) "\nAtributos: " (itoa atts) ) ) (princ) ) (defun c:nqf nil (nqf (ssget '((0 . "TEXT,ATTDEF")))))
    1 point
  46. Hey glad to see some one else that plays god and walks on water look at my image.
    1 point
  47. I had this, I have cleaned up, IIRC it works pretty similar if not exactly like the old Softdesk Continuous Copy. ;;; Allows you to copy objects multiple times at a typed in distance and angle. | ;;; | ;;; |ContCop.lsp| similar to SoftEngine command Continuous Copy | ;;; | ;;; https://www.cadtutor.net/forum/topic/89869-continuous-copylsp/#comment-648783 | ;;; | ;;; By SLW210 (Steve Wilson) | ;;; | ;;;_________________________________________________________________________________________| ;;; | ;;; August 18th, 2024 | ;;; | ;;; | ;;; | ;;; | ;;;_________________________________________________________________________________________| ;;; | ;;; | (defun C:ContCop (/ ss ang dist dists temp pt1 pt2 oldOsnap) ;; Error handler for internal errors (defun ccerr (st) (if (or (/= st "Function cancelled") (= st "quit / exit abort")) (princ (strcat "\nError: " st)) ) (princ) ) ;; Set the error handler (setq *error* 'ccerr) ;; Store current Osnap setting (setq oldOsnap (getvar "OSMODE")) ;; Prompt user to select objects (prompt "\nSelect objects to copy: ") (command "select" "auto" pause) (setq ss (ssget "p")) ;; Prompt user to select the start and end points (initget 1) (setq pt1 (getpoint "\nSelect Start Point: ")) (initget 1) (setq pt2 (getpoint pt1 "\nSelect End Point: ")) ;; Calculate distance and angle (setq dist (distance pt1 pt2) ang (angtos (angle pt1 pt2) 0 6) dists 0.0 ) ;; Main loop for continuous copying (while (/= (setq temp (getdist (strcat "\nNext distance/Exit < " (rtos dist) " >: ") ) ) "Exit" ) (setq dists (+ dists (if (not temp) dist temp ) ) ) (setq temp (strcat "@" (rtos dists 2 6) "<" ang)) (command "COPY" ss "" "0,0" temp) ) ;; Restore original Osnap setting (setvar "OSMODE" oldOsnap) (princ) ) I am positive the others are better, but I need the practice, hopefully commented correctly for you and me both.
    1 point
  48. This seems to do the trick. I would use with caution. (defun c:ub () (vlax-for bl (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (setq nam (vla-get-name bl)) (if (= "*U" (substr nam 1 2)) (progn (setq nam2 (substr nam 2)) (vla-put-name bl nam2) (princ (strcat "\n" nam " ---> " nam2)) ) ) ) (princ) )
    1 point
  49. (vlax-put-property cells0 'item y x "textstring") I think, this works with text string or text string variable only. Because Excel treats images as special objects separate from cell values so, the lisp code you get in internet. also shifting down images and shifting right images in units of pixels, not cells. of course, there is a way to create a function using Excel's vba macro and insert an image into a cell, but I don't think it's a good way to put a macro in every target Excel file and change it to an .xlsm file for all work. or if you want use that sentence, can approach like this way making image to not replace. (with loop and indexing name of image) ='<img src=""full path of image" "width=100 height=100 ><table> and copy to clipboard and paste special to put unicode format texts. i success to put them all. but I failed to load image. it's not good way also. because images is not in excel. so, I thnk below is better and different way to approach make loop like this (defun c:ssw2 (/ index r c) (setq index 0) (setq r 1) (setq c 1) (while (c:ssw) (setq r (+ r 1)) (setq index (+ index 1)) ) ) and add this (setq addr (strcat (chr (+ 64 c)) (itoa r) ":" (chr (+ (ascii (chr (+ 64 c))) (1- 1))) (itoa (+ r (1- 1))))) (setq rng (vlax-get-property activesheet0 'Range addr)) (vlax-invoke Rng 'Select) in front of this (setq pic (vlax-get activesheet0 'Pictures)) ;Pictures object (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image because this routine is paste in current selected cell in excel. so, this additional code will change selected cell. but this is start from column 1, row 1 it will be change with this, paste it in front of ssw2 (setq ExcelApp (vl-catch-all-apply (function (lambda ()(vlax-get-or-create-object "Excel.Application"))))) (if (vl-catch-all-error-p (setq Wbk (vl-catch-all-apply (function (lambda () (vlax-get-property ExcelApp "ActiveWorkBook")))))) (progn (alert "open Excel before you run this") (exit) (*error* nil) (princ) ) ) (setq Sht (vl-catch-all-apply (function (lambda () (vlax-get-property ExcelApp "ActiveSheet"))))) (vlax-put-property ExcelApp 'visible :vlax-true) (vlax-put-property ExcelApp 'ScreenUpdating :vlax-true) (vlax-put-property ExcelApp 'DisplayAlerts :vlax-false) (princ "\n go to excel then select cell to paste picture") (if (not (vl-catch-all-error-p (setq Rng (vl-catch-all-apply (function (lambda () (vlax-variant-value (vlax-invoke-method (vlax-get-property Wbk 'Application) 'Inputbox "select 1 cell you put in : " "ssw" nil nil nil nil nil 8)))))))) (progn (vlax-put-property ExcelApp 'DisplayAlerts :vlax-true) (setq r (vlax-get-property Rng 'row)) (setq c (vlax-get-property Rng 'column)) ExcelApp and Wbk is same with in ssw's. you can optimize this. and then select entire row. and change row height ============= like this ; instant screenshot for excel - 2022.03.07 exceed ; open target excel sheet before run this lisp. ; ; - command ; ssw - screenshot .wmf to selected cell in excel ; ssp - screenshot .png to selected cell in excel ; ssw2 - screenshot .wmf to excel continuously from selected cell ; ssp2 - screenshot .png to excel continuously from selected cell ; ; note - If the height is much longer than the width, a wider range than the set width can be seen. ; Due to a limitation in Excel, the maximum cell height is 409.5. (vl-load-com) (defun c:ssw (/ *error* ods acdoc pt1 pt2 ph x_dist_selection y_dist_selection xy_ratio input_width input_height ss app activeworkbook0 activesheet0 cells0 shape pic picture width_you_want) (setvar "cmdecho" 0) (setq ods (getvar "osmode")) (setvar "osmode" 0) (LM:startundo (LM:acdoc)) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar "cmdecho" 1) (setvar "osmode" ods) (princ) ) (princ "\nPlease open the excel sheet before running.\nInserts the selected area screenshot into the selected cell in Excel as a wmf image. (background transparent)") (ex:ESMAKE) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (setq pt1 (getpoint "\nSelect the first point:") pt2 (getcorner pt1 "\nselect the second point:") ph (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) "-" (rtos (getvar 'cdate) 2 10) ".wmf") ;edited line ) (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line (setq input_width 1000) ;input fixed value for simplify (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) ) (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited (setq input_height (+ input_height 55)) ; 55 is my environment gap of window size & image size. shoud be edited (if (= (findfile ph) nil) (progn (princ "\nCreate new image file ") ) (progn (vl-file-delete ph) (princ "\nReplace image file") ) ) (if (setq ss (ssget "c" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC")))) (progn (command "_Zoom" "w" pt1 pt2 "") (vla-put-height acdoc input_height) ;edited line (vla-put-width acdoc input_width) ;edited line (command "_wmfout" ph "all" "") ;edited line for all entities, replace with (command "_wmfout" ph ss "") ) ) (command "_Zoom" "p") (vla-put-windowstate acdoc 3) ;edited line (command "_syswindows" "c") ;edited line (setvar "osmode" ods) (princ "\ndone.") (princ (strcat "\nimage output path:" ph)) (setq app (vlax-get-or-create-object "Excel.Application")) (vla-put-visible app :vlax-true) (vlax-put-property app 'ScreenUpdating :vlax-true) (setq activeworkbook0 (vlax-get-property app 'ActiveWorkbook) ) (setq activesheet0 (vlax-get-property activeworkbook0 'ActiveSheet) ) (setq cells0 (vlax-get-property activesheet0 'cells)) (setq pic (vlax-get activesheet0 'Pictures)) ;Pictures object (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image (vlax-invoke picture 'select) ;select this image (setq shape (vlax-get (vlax-get-property app 'selection) 'shapeRange) ) ;picture object ;(vlax-put shape 'LockAspectRatio 0) ;Release aspect lock ;(vlax-put shape 'Height (/ input_height 3)) ;Set the height of the image (pixels) (setq width_you_want 30) ;edit this 30 value. this is same with width property in excel. (vlax-put shape 'width (* 28.3464566929 width_you_want)) ;Set the width of the image (pixels) ;(vlax-invoke shape 'IncrementTop input_height) ;Set the image downshift distance (pixels) ;(vlax-invoke shape 'IncrementLeft input_width) ;Set the image right shift distance (pixels) ; closing.. ;(vlax-invoke-method app 'Saveas (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx")) ;(vlax-invoke-method app 'Close) ;(vlax-invoke-method app 'Quit) (LM:endundo (LM:acdoc)) (setvar "cmdecho" 1) (setvar "osmode" ods) (princ) ) (defun c:ssp (/ *error* ods acdoc pt1 pt2 ph x_dist_selection y_dist_selection xy_ratio input_width input_height ss app activeworkbook0 activesheet0 cells0 shape pic picture width_you_want ) (setvar "cmdecho" 0) (setq ods (getvar "osmode")) (setvar "osmode" 0) (LM:startundo (LM:acdoc)) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar "cmdecho" 1) (setvar "osmode" ods) (princ) ) (princ "\nPlease open the excel sheet before running.\nInserts the selected area screenshot into the selected cell in Excel as a png image.") (ex:ESMAKE) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (setq pt1 (getpoint "\nSelect the first point:") pt2 (getcorner pt1 "\nselect the second point:") ph (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) "-" (rtos (getvar 'cdate) 2 10) ".png") ;edited line ) (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line (setq input_width 1200) ;input fixed value for simplify (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) ) (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited (setq input_height (+ input_height 55)) ; 45 is my environment gap of window size & image size. shoud be edited (if (= (findfile ph) nil) (progn (princ "\nCreate new image file ") ) (progn (vl-file-delete ph) (princ "\nReplace image file") ) ) (if (setq ss (ssget "c" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC")))) (progn (command "_Zoom" "w" pt1 pt2 "") (vla-put-height acdoc input_height) ;edited line (vla-put-width acdoc input_width) ;edited line (command "_pngout" ph "all" "") ;edited line for all entities, replace with (command "_pngout" ph ss "") ) ) (command "_Zoom" "p") (vla-put-windowstate acdoc 3) ;edited line (command "_syswindows" "c") ;edited line (setvar "osmode" ods) (princ "\ndone.") (princ (strcat "\nimage output path:" ph)) (setq app (vlax-get-or-create-object "Excel.Application")) (vla-put-visible app :vlax-true) (vlax-put-property app 'ScreenUpdating :vlax-true) (setq activeworkbook0 (vlax-get-property app 'ActiveWorkbook) ) (setq activesheet0 (vlax-get-property activeworkbook0 'ActiveSheet) ) (setq cells0 (vlax-get-property activesheet0 'cells)) (setq pic (vlax-get activesheet0 'Pictures)) ;Pictures object (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image (vlax-invoke picture 'select) ;select this image (setq shape (vlax-get (vlax-get-property app 'selection) 'shapeRange) ) ;picture object ;(vlax-put shape 'LockAspectRatio 0) ;Release aspect lock ;(vlax-put shape 'Height (/ input_height 3)) ;Set the height of the image (pixels) (setq width_you_want 30) ;edit this 30 value. this is same with width property in excel. (vlax-put shape 'width (* 28.3464566929 width_you_want)) ;Set the width of the image (pixels) ;(vlax-invoke shape 'IncrementTop input_height) ;Set the image downshift distance (pixels) ;(vlax-invoke shape 'IncrementLeft input_width) ;Set the image right shift distance (pixels) ; closing.. ;(vlax-invoke-method app 'Saveas (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx")) ;(vlax-invoke-method app 'Close) ;(vlax-invoke-method app 'Quit) (LM:endundo (LM:acdoc)) (setvar "cmdecho" 1) (setvar "osmode" ods) (princ) ) (defun c:ssw2 (/ *error* addr selectedcolumns columnwidthtofit xlrows xlcolumns rowheighttofit selectedrows app index r c rng activeworkbook0 activesheet0 ods acdoc pt1 pt2 ph x_dist_selection y_dist_selection xy_ratio input_width input_height ss cells0 shape pic picture width_you_want) (setvar "cmdecho" 0) (setq ods (getvar "osmode")) (setvar "osmode" 0) (LM:startundo (LM:acdoc)) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar "cmdecho" 1) (setvar "osmode" ods) (princ) ) (princ "\n Screenshot Loop") (ex:ESMAKE) (setq app (vlax-get-or-create-object "Excel.Application")) (if (vl-catch-all-error-p (setq activeworkbook0 (vl-catch-all-apply (function (lambda () (vlax-get-property app "ActiveWorkBook")))))) (progn (alert "open Excel before you run this") (exit) (*error* nil) (princ) ); end of progn ); end of if (setq activesheet0 (vl-catch-all-apply (function (lambda () (vlax-get-property app "ActiveSheet"))))) (setq xlrows (vlax-get-property activesheet0 'Rows)) (setq xlcolumns (vlax-get-property activesheet0 'Columns)) (vlax-put-property app 'visible :vlax-true) (vlax-put-property app 'ScreenUpdating :vlax-true) (vlax-put-property app 'DisplayAlerts :vlax-false) (princ "\n go to excel then select cell to paste picture") (if (not (vl-catch-all-error-p (setq rng (vl-catch-all-apply (function (lambda () (vlax-variant-value (vlax-invoke-method (vlax-get-property activeworkbook0 'Application) 'Inputbox "select 1 cell you put in : " "ssw" nil nil nil nil nil 8)))))))) (progn (vlax-put-property app 'DisplayAlerts :vlax-true) (setq r (vlax-get-property rng 'row)) (setq c (vlax-get-property rng 'column)) ); end of progn );end of if (setq index 0) (while (princ "\nPlease open the excel sheet before running.\nInserts the selected area screenshot into the selected cell in Excel as a wmf image. (background transparent)") (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (setq pt1 (getpoint "\nSelect the first point:") pt2 (getcorner pt1 "\nselect the second point:") ph (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) "-" (rtos (getvar 'cdate) 2 10) ".wmf") ;edited line ) (setq x_dist_selection 0) (setq y_dist_selection 0) (setq xy_ratio 0) (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line (setq input_width 1000) ;input fixed value for simplify (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) ) (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited (setq input_height (+ input_height 55)) ; 55 is my environment gap of window size & image size. shoud be edited (if (= (findfile ph) nil) (progn (princ "\nCreate new image file ") ) (progn (vl-file-delete ph) (princ "\nReplace image file") ) ) (if (setq ss (ssget "c" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC")))) (progn (command "_Zoom" "w" pt1 pt2 "") (vla-put-height acdoc input_height) ;edited line (vla-put-width acdoc input_width) ;edited line (command "_wmfout" ph "all" "") ;edited line for all entities, replace with (command "_wmfout" ph ss "") ) ) (command "_Zoom" "p") (vla-put-windowstate acdoc 3) ;edited line (command "_syswindows" "_hor") ;edited line (setvar "osmode" ods) (princ "\ndone.") (princ (strcat "\nimage output path:" ph)) (setq app (vlax-get-or-create-object "Excel.Application")) (vla-put-visible app :vlax-true) (vlax-put-property app 'ScreenUpdating :vlax-true) (setq activeworkbook0 (vlax-get-property app 'ActiveWorkbook) ) (setq activesheet0 (vlax-get-property activeworkbook0 'ActiveSheet) ) (setq cells0 (vlax-get-property activesheet0 'cells)) (setq addr (strcat (chr (+ 64 c)) (itoa r) ":" (chr (+ (ascii (chr (+ 64 c))) (1- 1))) (itoa (+ r (1- 1))))) (setq rng (vlax-get-property activesheet0 'Range addr)) (vlax-invoke Rng 'Select) (setq pic (vlax-get activesheet0 'Pictures)) ;Pictures object (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image (vlax-invoke picture 'select) ;select this image (setq shape (vlax-get (vlax-get-property app 'selection) 'shapeRange) ) ;picture object ;(vlax-put shape 'LockAspectRatio 0) ;Release aspect lock ;(vlax-put shape 'Height (/ input_height 3)) ;Set the height of the image (pixels) (setq width_you_want 10) ;edit this 30 value. this is same with width property in excel. (vlax-put shape 'width (* 28.3464566929 width_you_want)) ;Set the width of the image (pixels) (setq rowheighttofit (* (* width_you_want xy_ratio) 28.3464566929));8.5125)) (setq columnwidthtofit (* width_you_want 4.71267)); (rtos (* 28.3464566929 width_you_want) 2 0)) (if (> rowheighttofit 409) (setq rowheighttofit 409)) (setq selectedrows (vlax-variant-value (vlax-get-property xlrows 'item r))) (vlax-put-property selectedrows 'RowHeight rowheighttofit) (setq selectedcolumns (vlax-variant-value (vlax-get-property xlcolumns 'item c))) (vlax-put-property selectedcolumns 'ColumnWidth columnwidthtofit) ; closing.. ;(vlax-invoke-method app 'Saveas (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx")) ;(vlax-invoke-method app 'Close) ;(vlax-invoke-method app 'Quit) (setq r (+ r 1)) (setq index (+ index 1)) ); end of while (LM:endundo (LM:acdoc)) (setvar "cmdecho" 1) (setvar "osmode" ods) (princ) ) (defun c:ssp2 (/ *error* addr selectedcolumns columnwidthtofit xlrows xlcolumns rowheighttofit selectedrows app index r c rng activeworkbook0 activesheet0 ods acdoc pt1 pt2 ph x_dist_selection y_dist_selection xy_ratio input_width input_height ss cells0 shape pic picture width_you_want) (setvar "cmdecho" 0) (setq ods (getvar "osmode")) (setvar "osmode" 0) (LM:startundo (LM:acdoc)) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar "cmdecho" 1) (setvar "osmode" ods) (princ) ) (princ "\n Screenshot Loop") (ex:ESMAKE) (setq app (vlax-get-or-create-object "Excel.Application")) (if (vl-catch-all-error-p (setq activeworkbook0 (vl-catch-all-apply (function (lambda () (vlax-get-property app "ActiveWorkBook")))))) (progn (alert "open Excel before you run this") (exit) (*error* nil) (princ) ); end of progn ); end of if (setq activesheet0 (vl-catch-all-apply (function (lambda () (vlax-get-property app "ActiveSheet"))))) (setq xlrows (vlax-get-property activesheet0 'Rows)) (setq xlcolumns (vlax-get-property activesheet0 'Columns)) (vlax-put-property app 'visible :vlax-true) (vlax-put-property app 'ScreenUpdating :vlax-true) (vlax-put-property app 'DisplayAlerts :vlax-false) (princ "\n go to excel then select cell to paste picture") (if (not (vl-catch-all-error-p (setq rng (vl-catch-all-apply (function (lambda () (vlax-variant-value (vlax-invoke-method (vlax-get-property activeworkbook0 'Application) 'Inputbox "select 1 cell you put in : " "ssw" nil nil nil nil nil 8)))))))) (progn (vlax-put-property app 'DisplayAlerts :vlax-true) (setq r (vlax-get-property rng 'row)) (setq c (vlax-get-property rng 'column)) ); end of progn );end of if (setq index 0) (while (princ "\nPlease open the excel sheet before running.\nInserts the selected area screenshot into the selected cell in Excel as a png image. (background transparent)") (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (setq pt1 (getpoint "\nSelect the first point:") pt2 (getcorner pt1 "\nselect the second point:") ph (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) "-" (rtos (getvar 'cdate) 2 10) ".png") ;edited line ) (setq x_dist_selection 0) (setq y_dist_selection 0) (setq xy_ratio 0) (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line (setq input_width 1000) ;input fixed value for simplify (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) ) (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited (setq input_height (+ input_height 55)) ; 55 is my environment gap of window size & image size. shoud be edited (if (= (findfile ph) nil) (progn (princ "\nCreate new image file ") ) (progn (vl-file-delete ph) (princ "\nReplace image file") ) ) (if (setq ss (ssget "c" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC")))) (progn (command "_Zoom" "w" pt1 pt2 "") (vla-put-height acdoc input_height) ;edited line (vla-put-width acdoc input_width) ;edited line (command "_pngout" ph "all" "") ;edited line for all entities, replace with (command "_pngout" ph ss "") ) ) (command "_Zoom" "p") (vla-put-windowstate acdoc 3) ;edited line (command "_syswindows" "_hor") ;edited line (setvar "osmode" ods) (princ "\ndone.") (princ (strcat "\nimage output path:" ph)) (setq app (vlax-get-or-create-object "Excel.Application")) (vla-put-visible app :vlax-true) (vlax-put-property app 'ScreenUpdating :vlax-true) (setq activeworkbook0 (vlax-get-property app 'ActiveWorkbook) ) (setq activesheet0 (vlax-get-property activeworkbook0 'ActiveSheet) ) (setq cells0 (vlax-get-property activesheet0 'cells)) (setq addr (strcat (chr (+ 64 c)) (itoa r) ":" (chr (+ (ascii (chr (+ 64 c))) (1- 1))) (itoa (+ r (1- 1))))) (setq rng (vlax-get-property activesheet0 'Range addr)) (vlax-invoke Rng 'Select) (setq pic (vlax-get activesheet0 'Pictures)) ;Pictures object (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image (vlax-invoke picture 'select) ;select this image (setq shape (vlax-get (vlax-get-property app 'selection) 'shapeRange) ) ;picture object ;(vlax-put shape 'LockAspectRatio 0) ;Release aspect lock ;(vlax-put shape 'Height (/ input_height 3)) ;Set the height of the image (pixels) (setq width_you_want 10) ;edit this 30 value. this is same with width property in excel. (vlax-put shape 'width (* 28.3464566929 width_you_want)) ;Set the width of the image (pixels) (setq rowheighttofit (* (* width_you_want xy_ratio) 28.3464566929));8.5125)) (setq columnwidthtofit (* width_you_want 4.71267)); (rtos (* 28.3464566929 width_you_want) 2 0)) (if (> rowheighttofit 409) (setq rowheighttofit 409)) (setq selectedrows (vlax-variant-value (vlax-get-property xlrows 'item r))) (vlax-put-property selectedrows 'RowHeight rowheighttofit) (setq selectedcolumns (vlax-variant-value (vlax-get-property xlcolumns 'item c))) (vlax-put-property selectedcolumns 'ColumnWidth columnwidthtofit) ; closing.. ;(vlax-invoke-method app 'Saveas (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx")) ;(vlax-invoke-method app 'Close) ;(vlax-invoke-method app 'Quit) (setq r (+ r 1)) (setq index (+ index 1)) ); end of while (LM:endundo (LM:acdoc)) (setvar "cmdecho" 1) (setvar "osmode" ods) (princ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) (defun ex:ESMAKE ( ) ;from BIGAL's ah:chkexcel (setq excelapp (vlax-get-or-create-object "Excel.Application")) (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add) (vlax-put Excelapp "visible" :vlax-true) (setq Workbooks (vlax-get-property ExcelApp 'Workbooks)) (setq Sheets (vlax-get-property ExcelApp 'Sheets)) (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet)) (setq accell (vlax-get-property ExcelApp 'Activecell)) (setq xlcols (vlax-get-property acsheet 'Columns)) (setq xlrows (vlax-get-property acsheet 'Rows)) (setq cell (vlax-get-property acsheet 'Cells)) ) (princ "\nSSW, SSP, SSW2, SSP2 - loading complete")
    1 point
×
×
  • Create New...