Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 03/20/2024 in all areas

  1. @Clint OK - well since I have already done most of the work for you, I might was well give you a full solution. See the attached. I improved the code to have an UNDO group, and run quietly, eliminating the command echoing and displaying just the results. You will still need to alter the code for your desired old and new text styles. If the new text style is already in the drawing, it will just use what is defined rather than create it. ;|============================================================== CHTS.lsp written by Phil Kenewell - 3/19/2024 Description: This program converts all Text objects (TEXT, MTEXT, RTEXT) from one Text style to another, then purges the old text style. The desired styles need to be preset in the variables noted in the comments of the code. Last Update: Initial Release 3/20/2024 ===============================================================|; (defun C:CHTS (/ ce cnt d el NewFontFile NewTextHght NewTextoblq NewTextStyle NewTextWdth OldTextStyle ss ts) ;; Presets for Old and New Text style names. (setq OldTextStyle "MyoldStyle" ;; Old Style to Purge NewTextStyle "MyNewStyle" ;; New style to move text objects to NewFontFile "arial.ttf" ;; Font file for new Text. NewTextHght 0.0 ;; Preset hieght (if needed) for new text style NewTextWdth 1.0 ;; Width Factor (if needed) for new text style NewTextoblq 0.0 ;; Oblique angle (if needed) for new text style ) ;; Create an undo mark. (vla-startundomark (setq d (vla-get-activedocument (vlax-get-acad-object)))) ;; Save the values for cmdecho and textstyle. (setq ce (getvar "cmdecho") ts (getvar "textstyle")) ;; turn off cmdecho to clean up command line echoing. (setvar "cmdecho" 0) ;; Create a selection set of the Text Objects and Text Style: (setq ss (ssget "X" (list (cons 0 "*TEXT")(cons 7 OldTextStyle)))) ;; If the Style table does not have the new Style Name, Make it. (if (not (tblsearch "STYLE" NewTextStyle)) (command "._-style" NewTextStyle NewFontFile NewTextHght NewTextWdth NewTextoblq "_n" "_n") ) ;; If the selection set is found: (if ss ;; Iterate through the selection set - set counter to the length of the set: (repeat (setq cnt (sslength ss)) ;; Get the entity list of item in selection set. (setq el (entget (ssname ss (setq cnt (1- cnt)))) ;; Substitute the new Text Style name in place of the old one. el (subst (cons 7 NewTextStyle) (assoc 7 el) el) ) ;; Modify the entity. (entmod el) (if (= cnt 0)(princ (strcat "\n(" (itoa (sslength ss)) ") Text objects were changed to style \"" NewTextStyle "\"."))) ) (princ (strcat "\nNo Text objects with style \"" OldTextStyle "\" were found.")) ) ;; Purge the old Style. (vla-delete (vlax-ename->vla-object (tblobjname "STYLE" OldTextStyle))) (if (not (tblsearch "STYLE" OldTextStyle)) (princ (strcat "\nText Style \"" OldTextStyle "\" was successfully purged.")) ) ;; If the previously current text style was not the old style to be purged, then reset the text style to what it was. (if (/= ts OldTextStyle)(setvar "textstyle" ts)) ;; Set cmdecho to previous value (setvar "cmdecho" ce) ;; End the undo mark (vla-endundomark d) ;; exit quietly (princ) ) CHTS.lsp
    3 points
  2. @Clint So - did you try doing the code? Were you successful? do you have any questions? We like to think that we are actually educating new coders, since that is the purpose of this forum. It's not here to request free programs, although that's what happens more often than not.
    2 points
  3. 1 point
  4. To pkenewell: Your CHTS.lsp worked like magic. With nearly 1,000 detail drawings with various issues, including the text style conundrum, now automated away, processing them will now take at most 5% of the former rate. You inspired me to take time to learn LISP! Clint
    1 point
  5. Just can't help yourself. Get half way there, give the good advice, off you go OP all yours to finish off, brilliant learning opportunity, but... while thinking about it I'll just do it to satisfy myself... we all do it
    1 point
  6. @sadishpaul what you asking for is 20 times more complex. I don't think you're gonna get a freebie on this one, unless someone really wants the challenge. I suggest you get https://superboundary.com instead, and no - i do not represent this company nor have any affiliation with them. I just did a simple google search. I think the price is well worth it if you need this. Also see:
    1 point
  7. I thank you for taking your valuable time here getting us out of a "sticky" spot. Now, to learn from this program and others and give back one day soon! Yours, Clint
    1 point
  8. Might also look at purging anonymous blocks - not sure if it will be a solution but if all else fails.. ( I think there was either a post on here somewhere or Lee Mac has something on his website)
    1 point
  9. @Butch I incorporated your marker For the '+' sign I put it as a prefix, there is no other way with the fields (you cannot make conditions in them). The downside is that for negative numbers it will display '+-'. If you want to return as before, remove the '+' on line 471 (leaving the comma after) level-pt(Butch).lsp
    1 point
  10. this version should only take the layer property if the property set is ByLayer (defun c:layZ (/ layerswap doc) ;| Sets object layer by string. Creates if neccessary @Param obj \<vla-obj> @Param str \<string> name of the layer the object should be set to. @Returns ? |; (defun layerswap (obj str / makelayer doc oldlayer oldlock) (defun makelayer (str / layers) (setq layers (vla-get-layers doc)) (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list layers str)))) t (vla-add layers str) ) ) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (if (makelayer str) (progn (setq oldlayer (vla-item (vla-get-layers doc)(vla-get-layer obj))) (setq oldlock (vla-get-lock oldlayer)) (vla-put-lock oldlayer :vlax-false) (vla-put-layer obj str) (vla-put-lock oldlayer oldlock) ) ) ) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vlax-for item (vla-get-modelspace doc) ; goes trough every drawing object in model area (mapcar '(lambda (property layervalue) (if (and (vlax-property-available-p item property t) ;checks if the item has the property (= layervalue (vlax-get-property item property)) ;checks if item is ByLayer ) (vlax-put-property item property (vlax-get-property (vla-item (vla-get-layers doc)(vla-get-layer item)) property)) ;gets layer property and sets it to item ) ) '("Color" "LineType" "LineWeight"); Property '(256 "ByLayer" -1); Layervalue ) (layerswap item "0") ; sets obj layer to 0 ) )
    1 point
  11. Dont know about BrisCAD but i guess its the same as for autocad. The Syntax for autoload is: (autoload filename cmdlist) So example filename could be: "Z:/AutoLisp/Creations/LayZ.lsp" cmdlist is the command list, here you list the commands you want to autoload wich would just be this: '("LayZ") so the full autoload would be like that: (autoload "Z:/AutoLisp/Creations/Layz.lsp" '("LayZ")) ;Layer - Layer change to zero and retains original entity properties also what i noticed about that code, is that there is not check if the Properties the entity has is already indivudual, right now it always takes the layers property
    1 point
  12. "single word to insert a block" -Insert use it in a lisp. Another B22 inserts block with a link to name "22" say in a list. I have a reactor code that lets you type say Bz, B22 etc it will remove the B but keep what is after and use that in a defun which may be a -insert defun. No Dcl. I have posted this before, you could do a Bxx.There is say 26 different versions available. I have Offset Circle Fillet in one version. fillet reactor.lsp
    1 point
  13. "hidden object" it may be text in a block so that is not obvious, a bit of a task to find, you can go through every block and check text style. Google not something I have. Understand where your at had to try and fix a dwt that one guy wanted to use he did not care if it gave error messages about text styles on opening as it worked.
    1 point
  14. @Clint NOTE: Oops - I had to update the code because I messed up the counter in the (repeat... part. Previous post is updated. Another Hint - if you wrap this code in between (defun c:MyCommand () ... ), it will do what you need. you'll have to change "OldStyleName" and "NewStyleName" to your needs.
    1 point
  15. Thank you, tombu! Very useful!
    1 point
×
×
  • Create New...