Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 12/01/2022 in all areas

  1. Got it! You rock! Thank you again.
    1 point
  2. A keyword has at least a 1st Character A-Z so that is 26 menu's of around 20+ lisps. Or group the lisps via subject like the plot has 5 lisps. You can have more than one pop menu dedicated to your lisps. I worked with multiple staff and they would not know the key word to look for, past maybe a couple of characters. At least with a menu you can quickly search another menu group. Its like digital help if you don't know the correct word to look for you get no help. That image has around 200 lisps plus about 400 block inserts.
    1 point
  3. BigAl, there are ALOT of files. I thought a keyword approach was easier than creating a pull down menu where the user still needs to look for what they want.
    1 point
  4. @rcb007 LOL you are right. I have corrected this with another update to the original post; to mask the "non-case sensitive" search into the background and just show the original files in the results. Try the update and let me know.
    1 point
  5. @rcb007 Give this a try - I threw it together using some great functions from Lee Mac's Library. After you load it, Type FSEARCH to start the command. Note - minimally tested and no error handling. EDIT: Note - this starts a "Browse for Folder" dialog starting in the search path you noted. you can change the path or just select "OK" to search in the default path. If you don't want the dialog at all, just comment out the line "(setq spth (LM:browseforfolder "Select Search Folder" spth 0))". EDIT2: I've updated the code to be a more generalized version that you can easily change the file type pattern. Note how many extension types can be loaded as a LISP file. I am also using some more advanced techniques to filter the file list. Someone else here may be able to do this more efficiently, but I enjoyed playing around with it. EDIT3: I forgot to add "(vl-load-com)" since I was using Visual LISP; now added to the code. EDIT4: Removed case sensitivity by forcing everything to uppercase. EDIT5: Masked the non-case sensitive search and show the original files in the results list. ;; Browse for Folder - Lee Mac ;; Displays a dialog prompting the user to select a folder. ;; msg - [str] message to display at top of dialog ;; dir - [str] [optional] root directory (or nil) ;; bit - [int] bit-coded flag specifying dialog display settings ;; Returns: [str] Selected folder filepath, else nil. (defun LM:browseforfolder ( msg dir bit / err fld pth shl slf ) (setq err (vl-catch-all-apply (function (lambda ( / app hwd ) (if (setq app (vlax-get-acad-object) shl (vla-getinterfaceobject app "shell.application") hwd (vl-catch-all-apply 'vla-get-hwnd (list app)) fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg bit dir) ) (setq slf (vlax-get-property fld 'self) pth (vlax-get-property slf 'path) pth (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth)) ) ) ) ) ) ) (if slf (vlax-release-object slf)) (if fld (vlax-release-object fld)) (if shl (vlax-release-object shl)) (if (vl-catch-all-error-p err) (prompt (vl-catch-all-error-message err)) pth ) ) ;; List Box - Lee Mac ;; Displays a DCL list box allowing the user to make a selection from the supplied data. ;; msg - [str] Dialog label ;; lst - [lst] List of strings to display ;; bit - [int] 1=allow multiple; 2=return indexes ;; Returns: [lst] List of selected items/indexes, else nil (defun LM:listbox ( msg lst bit / dch des tmp rtn ) (cond ( (not (and (setq tmp (vl-filename-mktemp nil nil ".dcl")) (setq des (open tmp "w")) (write-line (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select=" (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}" ) des ) (not (close des)) (< 0 (setq dch (load_dialog tmp))) (new_dialog "listbox" dch) ) ) (prompt "\nError Loading List Box Dialog.") ) ( t (start_list "list") (foreach itm lst (add_list itm)) (end_list) (setq rtn (set_tile "list" "0")) (action_tile "list" "(setq rtn $value)") (setq rtn (if (= 1 (start_dialog)) (if (= 2 (logand 2 bit)) (read (strcat "(" rtn ")")) (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")"))) ) ) ) ) ) (if (< 0 dch) (unload_dialog dch) ) (if (and tmp (setq tmp (findfile tmp))) (vl-file-delete tmp) ) rtn ) (defun c:FSearch (/ flst kstr loadlst pat spth sstr) (vl-load-com) (setq spth "C:\\AutoCAD\\Tools" pat (list "LSP" "MNL" "FAS" "VLX" "DLL") ) (if (and (setq kstr (getstring "\nEnter a Keyword to Search for <ENTER for *>: ")) (setq kstr (if (= kstr "") "*" (strcase kstr))) (setq spth (LM:browseforfolder "Select Search Folder" spth 0)) (setq flst (vl-sort (vl-directory-files spth "*" 1) '<)) ) (if (and flst (setq sstr (vl-string-right-trim "," (apply 'strcat (mapcar '(lambda (x) (strcat "*" kstr "*." x ",")) pat)))) (setq flst (vl-remove-if '(lambda (y) (= y nil)) (mapcar '(lambda (x)(if (wcmatch (strcase x) sstr) x)) flst))) (setq Loadlst (LM:listbox "Select Files to Load" flst 1)) ) (foreach f loadlst (cond ((wcmatch (strcase (vl-filename-extension f)) "`.LSP,`.MNL,`.FAS,`.VLX") (load (strcat spth "\\" f) (strcat "\n\"" f "\" Failed to Load.")) ) ((= f ".DLL") (command "._netload" (strcat spth "\\" f)) ) ) ) (princ (strcat "\nNo files found for the specific types with the Keyword \"" kstr "\".")) ) ) (princ) )
    1 point
  6. Sorry for late respone, thanks sincerely for you reply and effort. It replaced te t in reverse order but did the trick anyway Again sorry for my late reply
    1 point
  7. I have not done it for a while but should get back in the habit of when loading code add a little message at the end about how to run. I find "alert" is good but keep it outside the defun so it only displays once. (defun c:mycode ( / a s d f ) .......... ) (alert "to run just type MYCODE") or (defun c:mycode ( / a s d f ) .......... ) (c:mycode)
    1 point
  8. Maybe a simpler way you get the 4 points of the viewport then use a trans to convert the 4 points to mspace points you can then use a ssget "WP" pts. Remember to add the 1st point as last point so box closes. ie 5 points. You want the opposite of this, this takes a point in mspace with a twist viewport etc and converts it to a Pspace point. (setq psnewcen (trans (trans newcen 1 2) 2 3)) Sorry dont have the right way at my finger tips. Trying to remember if chspace works for pspace point converted to mspace I think it does. Tried this picked 4 corners of viewport and made a POINT. You can see the points in model, the red rectangles are the viewport windows seperate code.
    1 point
  9. Hello Try this (roughly tested) (vl-load-com) (defun l-coor2l-pt (lst flag / ) (if lst (cons (list (car lst) (cadr lst) (if flag (caddr lst) 0.0)) (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag) ) ) ) (defun c:SelTextByViewPort ( / AcDoc Space js pt_v id_vp l h lst_pt js_obj UCS save_ucs WSC nw_pl ob_lst_pt) (setvar "CMDECHO" 0) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (vla-get-PaperSpace AcDoc) ) (vla-StartUndoMark AcDoc) (if (eq (getvar "CTAB") "Model") (setvar "TILEMODE" 0)) (command "_.PSPACE") (princ "\nSelect a viewport: ") (while (null (setq js (ssget "_+.:E:S:L" (list '(0 . "VIEWPORT") '(67 . 1) (cons 410 (getvar "CTAB")) '(-4 . "!=") '(69 . 1) ) ) ) ) ) (setq pt_v (cdr (assoc 10 (setq dxf_ent (entget (setq ent (ssname js 0)))))) id_vp (cdr (assoc 69 dxf_ent)) l (cdr (assoc 40 dxf_ent)) h (cdr (assoc 41 dxf_ent)) lst_pt (list (list (- (car pt_v) (* 0.5 l)) (- (cadr pt_v) (* 0.5 h)) 0.0) (list (+ (car pt_v) (* 0.5 l)) (- (cadr pt_v) (* 0.5 h)) 0.0) (list (+ (car pt_v) (* 0.5 l)) (+ (cadr pt_v) (* 0.5 h)) 0.0) (list (- (car pt_v) (* 0.5 l)) (+ (cadr pt_v) (* 0.5 h)) 0.0) ) js_obj (ssadd) ) (entmakex (vl-list* (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 1) (cons 100 "AcDbPolyline") (cons 90 (length lst_pt)) (cons 70 1) (mapcar '(lambda (p) (cons 10 p)) lst_pt) ) ) (ssadd (setq nw_pl (entlast)) js_obj) (command "_.MSPACE") (setvar "CVPORT" id_vp) (command "_.PSPACE") (command "_.CHSPACE" js_obj "" (if (> id_vp 2) "")) (command "_.MSPACE") (setq Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) UCS (vla-get-UserCoordinateSystems AcDoc) save_ucs (vla-add UCS (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point (getvar "UCSXDIR")) (vlax-3d-point (getvar "UCSYDIR")) "CURRENT_UCS" ) ) (vla-put-Origin save_ucs (vlax-3d-point (getvar "UCSORG"))) (setq WCS (vla-add UCS (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(1.0 0.0 0.0)) (vlax-3d-Point '(0.0 1.0 0.0)) "TEMP_WCS")) (vla-put-activeUCS AcDoc WCS) (setq nw_pl (vlax-ename->vla-object nw_pl) ob_lst_pt (l-coor2l-pt (vlax-get nw_pl 'coordinates) nil) ) (vla-put-layer nw_pl "0") (vla-delete nw_pl) (sssetfirst nil (ssget "_WP" ob_lst_pt '((0 . "*TEXT")))) (and save_ucs (vla-put-activeUCS AcDoc save_ucs)) (and WCS (vla-delete WCS) (setq WCS nil)) (vla-EndUndoMark AcDoc) (setvar "CMDECHO" 1) (prin1) ) 0
    1 point
  10. I'd stick with the one labeled "what i've got" as it is the more acceptable solution.
    1 point
  11. No, shouldn't need to Here after the (command ...." anything in " " are text as you would type it in the command line, without the " " this is a variable defined earlier in the LISP. So PLINE is a variable - could be called anything. If you look further up in the LISP you should find what pline is set to be (it will have something like (setq pline ....) - and an internet search will show you what it is if you want to find out what the LISP is doing. In this case, there is no need to change anything else
    1 point
  12. My $0.05 just ssget text, then make a list as suggested maybe sort the list so always 1 2 3 4 then just use a while/repeat/foreach select destination text it will update as 1 2 3 4. This is very rough maybe needs sort and a proper exit when pick less than selection set. (defun c:mattext ( / ss lst x ent) (setq ss (ssget '((0 . "TEXT")))) (setq lst '()) (repeat (setq x (sslength ss)) (setq lst (cons (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))) lst)) ) (setq lst (reverse lst)) (setq x -1) (repeat (length lst) (setq ent (entget (car (entsel "\nPick text ")))) (entmod (subst (cons 1 (nth (setq x (1+ x)) lst)) (assoc 1 ent) ent)) ) (princ) )
    1 point
  13. Here is another option, copy and pasted from what I have, not perfect though (defun c:MSCTX ( / MySS MySS2 acount entcodes ent1 ent2 entlist1 entlist2 text01 text02 text11 text12 entcodes1 entcodes2 acount acounter explist ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun deletelistitem (mylist itemtodelete / acounter nextitem) ;;delete a list item (setq acounter 0) (while (< acounter (length mylist) ) (setq nextitem (car mylist)) (setq mylist (cdr mylist)) ;;chop off first element (if (/= nextitem itemtodelete) (progn (setq mylist (append mylist (list nextitem))) ;stick next item to the back );end progn );end if (setq acounter (+ acounter 1)) );end while (setq nextitem (car mylist)) (setq mylist (cdr mylist)) (setq mylist (append mylist (list nextitem))) mylist ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun deletedxfdata ( delent delentlist entcodes / acount acounter ) (setq acounter 0) (setq acount 0) (while (< acount (length entcodes)) (while (< acounter (length delentlist)) (if (= (car (nth acounter delentlist) ) (nth acount entcodes) ) (progn (entmod (setq delentlist (subst (cons (nth acount entcodes) "") (nth acounter delentlist) delentlist))) (entupd delent) ) ) (setq acounter (+ acounter 1)) );end while (setq acount (+ acount 1)) );end while delentlist ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun getfroment (ent listorstring entcodes / acount acounter mytext newtext stringtext) ;;get dotted pairs list (setq entlist (entget ent)) (setq enttype (cdr (assoc 0 entlist))) (setq acount 0) (while (< acount (length entlist)) (setq acounter 0) (while (< acounter (length entcodes)) (setq entcode (nth acounter entcodes)) (if (= (car (nth acount entlist)) entcode ) (progn (setq newtext (cdr (nth acount entlist))) (if (numberp newtext)(setq newtext (rtos newtext))) ;fix for real numbers (setq mytext (append mytext (list (cons (car (nth acount entlist)) newtext) )) ) );end progn );end if (setq acounter (+ acounter 1)) );end while (setq acount (+ acount 1)) );end while ;;get string from dotted pair lists (if (= listorstring "astring") ;convert to text (progn (if (> (length mytext) 0) (progn (setq acount 0) (setq temptext "") (while (< acount (length mytext)) (setq temptext (cdr (nth acount mytext)) ) (if (= (wcmatch temptext "LEADER_LINE*") nil)()(setq temptext "")) ;;Fix for Multileader 'Leader_Line' Text (if (= stringtext nil) (setq stringtext temptext) (setq stringtext (strcat stringtext temptext )) );end if (setq acount (+ acount 1)) );end while );end progn );end if (if (= stringtext nil)(setq stringtext "")) (setq mytext stringtext) );end progn );end if mytext ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;get text as a string (defun gettextasstring ( enta entcodes / texta ) (if (= (getfroment enta "astring" entcodes) "") () (setq texta (getfroment enta "astring" entcodes)) ) texta ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun addinnewtext (newtext newentlist newent / ) (if (/= newtext nil) (progn (if (= (cdr (assoc 0 newentlist)) "DIMENSION") (progn ;;ent mod method, stops working at 2000-ish characters (entmod (setq newentlist (subst (cons 1 newtext) (assoc 1 newentlist) newentlist))) (entupd newent) );end progn (progn ;;vla-put-text string for large text blocks + 2000 characters? (vla-put-textstring (vlax-ename->vla-object newent) newtext) );end progn ) ;end if ) ;end progn (princ "\nSource text is not 'text'") );end if ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:MSCTX ( / MySS MySS2 acount entcodes ent1 ent2 entlist1 entlist2 text01 text02 text11 text12 entcodes1 entcodes2 acount acounter explist ) ;;get text 1 (setq MySS (ssget '((0 . "*TEXT")))) (setq acount 0) (while (< acount (sslength MySS)) (setq ent1 (ssname MySS acount)) (setq entlist1 (entget ent1)) (setq entcodes1 (list 3 4 1 172 304) ) (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string (princ (strcat "\nSelect Text to change to " text01 " or press ENTER to move on: ")) ;;loop till cancelled (while (/= nil (setq MySS2 (ssget "_:S" '((0 . "*TEXT"))))) (setq ent2 (ssname MySS2 0 )) ;;get text 2 (setq entlist2 (entget ent2)) (setq entcodes2 (list 3 4 1 172 304) ) (setq text02 (gettextasstring ent2 entcodes2) ) (setq entcodes2 (deletelistitem entcodes2 '1)) (setq entlist2 (deletedxfdata ent2 entlist2 entcodes2)) ;;put in new text (addinnewtext text01 entlist2 ent2) (princ (strcat "\nSelect Text to change to " text01 " or press ENTER to move on: ")) );end while (setq acount (+ acount 1)) ) (princ) )
    1 point
  14. This is what i use to copy text to another text. tho it doesn't allow you to select multiple to copy. https://autocadtips1.com/2012/02/27/autolisp-copy-text-to-table-cells/
    1 point
  15. Yes, this is possible, I think if you select all the first texts, either with a box or one after another, you can extract the text string from each (saved as a list), then taking that list update the new text string with that value in the order that you want. Doing it that way, you can select all the texts in one part of the drawing and then scroll to the new part to update the texts. How are your LISP abilities by the way, if we gave you fairly subtle hints would you be able to work it out or would you want something more complete? I know some people enjoy working it out after a few tips, some don't. I'll see if I can put something together later, should have some copy and paste stuff that I think might work
    1 point
  16. Your wanting to select the top row or group of text? then get asked what text to change to "1", what text to change to "2" ... that you pick with the mouse?
    1 point
  17. How do you want this to work? For example, Lee Mac has a copy and swap text routine (ctx and stx) where in this case you can select the texts one at a time and where to copy that value to. This is a good LISP. So for example you would select '1' above then 'X', then '2' then 'X' and so on to copy into where you want them to go to (http://lee-mac.com/copytext.html) For things like this I prefer this 1-1 approach, select original text, select text to change. It is possible to use selection sets to select the 2 sets of text, again my preference here is to select each text is turn, then move on to pasting them in turn, using a window to select all the texts can give unexpected results in my experience.
    1 point
×
×
  • Create New...