Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/14/2024 in all areas

  1. Hey, @pkenewell and @mhupp You are legends! This works good enough that it clears the mess 80%. Tried my inverted method, with keeping anything that has "[a-zA-Z]{3,}" but somehow it got rid of a lot of text. Anyway 'im happy with this!
    2 points
  2. 1 point
  3. its kinda a backwards way of thinking but when we modify an entity we are essentially "deleting" the old one and "creating" a new one.
    1 point
  4. entlast should pick up the last thing modified or created in the drawing. please upload a sample drawing
    1 point
  5. Finally, i success to do my thing Need to share my code with you if someone else need the inspiration of doing something lookalike. ;; Version 0.1 ;; First version ;; Version 0.2 ;; Minor adjustments ;; Version 0.3 ;; Added Zoom -e ;; Tidy up zoom before we do anything else (command "._zoom" "e") (defun c:getFormattedDate () (setq today (rtos (getvar "CDATE") 2 0)) (setq year (substr today 3 2)) (setq month (substr today 5 2)) (setq day (substr today 7 2)) (strcat year "." month "." day) ) ;; Create the date string (setq currentDate (c:getFormattedDate)) (defun c:getFileNameNoExtension () (setq fullFileName (getvar "DWGNAME")) ; Get the full file name with extension (setq fileName (vl-filename-base fullFileName)) ; Remove path and file extension ; Search for the position of the first underscore and trim the file name from there (setq pos (vl-string-search "_" fileName)) (if pos (setq fileName (substr fileName 1 pos)) ; If underscore exists, take only the part before _ ) fileName ; Return the modified file name ) ;; Create the drawing number string (setq drawingName (c:getFileNameNoExtension)) (defun c:getBoxName () ;; Get the full file name with extension (setq fullFileName (getvar "DWGNAME")) ;; Remove path and file extension (setq fileName (vl-filename-base fullFileName)) ;; Search for the position of the last hyphen (setq lastHyphenPos nil) (setq i 1) (while (setq pos (vl-string-search "-" fileName i)) (setq lastHyphenPos pos) (setq i (+ pos 1)) ) ;; Search for the position of the first underscore (setq firstUnderscorePos (vl-string-search "_" fileName)) ;; Check if both positions are found (if (and lastHyphenPos firstUnderscorePos) ;; Extract the substring between the hyphen and the underscore (setq boxName (substr fileName (+ lastHyphenPos 2) (- firstUnderscorePos lastHyphenPos 1))) ;; If any position is not found, set boxName to an empty string (setq boxName "") ) ;; Add a dot between letters and numbers (setq modifiedBoxName "") (setq len (strlen boxName)) (setq i 1) (while (<= i len) (setq char (substr boxName i 1)) (if (and (> i 1) (or (and (vl-string-search char "0123456789") (vl-string-search (substr boxName (- i 1) 1) "ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖabcdefghijklmnopqrstuvwxyzåäö")) (and (vl-string-search (substr boxName (- i 1) 1) "0123456789") (vl-string-search char "ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖabcdefghijklmnopqrstuvwxyzåäö")))) (setq modifiedBoxName (strcat modifiedBoxName "." char)) (setq modifiedBoxName (strcat modifiedBoxName char)) ) (setq i (1+ i)) ) (setq boxName modifiedBoxName) ;; Add a plus sign in front of the result (setq boxName (strcat "+" boxName)) ;; Return the modified file name boxName ) ;; Create the boxName string (setq boxName (c:getBoxName)) (defun replace-swedish-chars (str) (setq replacements (list '("Å" . "\\u00C5") '("Ä" . "\\u00C4") '("Ö" . "\\u00D6") '("å" . "\\u00E5") '("ä" . "\\u00E4") '("ö" . "\\u00F6"))) (foreach pair replacements (setq str (vl-string-subst (cdr pair) (car pair) str))) str ) (defun UpdateBlock (NewTitles / ss obj atts att tag NewText) ; Get all block references with type "INSERT" and name "EPCB000" (setq ss (ssget "X" '((2 . "EPCB000")))) ; find the title block (here (1 . "INSERT") is not needed) (setq obj (vlax-ename->vla-object (ssname ss 0))) ; Get the title block as a VLA object (setq atts (vlax-invoke obj 'Getattributes)) ; List VLA tags / attribute names (foreach att atts ; Loop through tags / attributes (setq tag (vla-get-tagstring att)) ; Get the 'real' tag name (setq NewText (assoc tag NewTitles)) ; Find the tag as a dotted pair in the provided list (if NewText ; Check if the tag is in the provided list (progn (setq NewText (cdr NewText)) ; get the new tag value (vla-put-textstring att NewText) ; update the tag (princ (strcat "\nTag: " tag ", New value: " NewText)) ; Print updated tag and value to the command line ) ; end progn ) ; end if ) ; end foreach ) ; end UpdateBlock ;; SEARCH AND REPLACE (defun read-utf8-string (str) str ) (defun replace-g11-t11 (str) (if str (progn ;; Replace "G11" with "G12" (setq str (vl-string-subst "G12" "G11" str)) ;; Replace "T11" with "T12" (setq str (vl-string-subst "T12" "T11" str)) ) ) str ) (defun replace-11-12 (str) (if str (setq str (vl-string-subst ".12." ".11." str)) ) str ) (defun processAttributes () ;; Set the encoding system to UTF-8 (setq *coding-system* 'utf-8) ;; Get the block reference (setq ss (ssget "X" '((0 . "INSERT")(2 . "EPCB000")))) (setq obj (vlax-ename->vla-object (ssname ss 0))) (setq atts (vlax-invoke obj 'Getattributes)) ;; Initialize D5, D9, and D14 (setq D5 nil) (setq D9 nil) (setq D14 nil) ;; Loop through the attributes and get their values (while atts (setq att (car atts)) (setq atts (cdr atts)) (setq tag (vla-get-tagstring att)) (setq value (vla-get-textstring att)) (cond ((equal tag "D5") (setq D5 (read-utf8-string value))) ((equal tag "D9") (setq D9 (read-utf8-string value))) ((equal tag "D14") (setq D14 (read-utf8-string value))) ) ) ;; Replace values in D5, D9, and D14 (setq D5 (replace-g11-t11 D5)) (setq D9 (replace-g11-t11 D9)) (setq D14 (replace-11-12 D14)) ;; Return the processed values (list D5 D9 D14) ) ;; Process D5, D9, and D14 (setq processedValues (processAttributes)) (setq D5 (nth 0 processedValues)) (setq D9 (nth 1 processedValues)) (setq D14 (nth 2 processedValues)) ;; Create a list of block tags and their values, with Swedish characters replaced with UTF-8 codes (setq NewTitles (mapcar (lambda (pair) (cons (car pair) (replace-swedish-chars (cdr pair)))) (list (cons "C2" "KRAFTSTATION") ;; Facility '( "C10" . "506") ;; Project number '( "D6" . "TBY") ;; Drawn border frame left side (cons "D7" currentDate) ;; Date border frame left side '( "D8" . "AN") ;; Reviewed border frame left side '( "RITAD_AV" . "TBY") ;; Drawn border frame bottom '( "GRANSK_AV" . "J") ;; Reviewed by border frame bottom '( "GODK_AV" . "L") ;; Approved by border frame bottom (cons "GODK_DAT." currentDate) ;; Approved date border frame bottom (cons "D4" boxName) ;; Description row 1 border frame bottom (cons "D5" D5) ;; Description row 2 border frame bottom (cons "D9" D9) ;; Description row 3 border frame bottom (cons "D14" D14) ;; Function border frame bottom ;; '( "D12" . "") ;; Document type border frame bottom (cons "D13" drawingName) ;; Drawing number border frame bottom ;; '( "D10" . "") ;; Room border frame bottom '( "NOT1" . "") ;; Clear revision note 1 '( "ÄNDRING1" . "") ;; Clear revision note 1 '( "DATUM1" . "") ;; Clear revision note 1 '( "INF.1" . "") ;; Clear revision note 1 '( "GODK.1" . "") ;; Clear revision note 1 '( "NOT2" . "") ;; Clear revision note 2 '( "ÄNDRING2" . "") ;; Clear revision note 2 '( "DATUM2" . "") ;; Clear revision note 2 '( "INF.2" . "") ;; Clear revision note 2 '( "GODK.2" . "") ;; Clear revision note 2 '( "NOT3" . "") ;; Clear revision note 3 '( "ÄNDRING3" . "") ;; Clear revision note 3 '( "DATUM3" . "") ;; Clear revision note 3 '( "INF.3" . "") ;; Clear revision note 3 '( "GODK.3" . "") ;; Clear revision note 3 ) )) (UpdateBlock NewTitles) ; use this list in the 'UpdateBlock' function ;; Update file name in the text field. (defun replace-text-in-area-with-filename (startpoint endpoint) ;; Get the file name including extension (setq fullFileName (getvar "DWGNAME")) ;; Get all text objects within the specified area (setq ss (ssget "C" startpoint endpoint '((0 . "TEXT")))) (if ss (progn (setq count (sslength ss)) (setq i 0) ;; Loop through all selected text objects and replace their text with the file name (while (< i count) (setq obj (vlax-ename->vla-object (ssname ss i))) (vla-put-TextString obj fullFileName) (setq i (1+ i)) ) (princ (strcat "\nReplaced text in " (itoa count) " objects with the file name: " fullFileName)) ) (princ "\nNo text objects found within the specified area.") ) ) ;; Define the start and end point for the area (setq startpoint (list 0 277.5 0)) (setq endpoint (list 7 242.5 0)) ;; Call the function to replace the text with the file name (replace-text-in-area-with-filename startpoint endpoint) (princ) ; exit quietly
    1 point
  6. Try this untested mods and get sure that you modify the tag name to suit yours as commented in codes below. (defun c:Test (/ sel int ent att spc bkn ) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (or *bkn* (setq *bkn* "A")) (if (and (or (initget 6 "A B") (setq *bkn* (cond ((getkword (strcat "\nSpecify block name A / B < " *bkn* " > : "))) (*bkn*))) ) (or (tblsearch "BLOCK" (setq bkn (strcat (strcat "Block " *bkn*)))) (alert (strcat "Attributed Block < " bkn " > was not found in drawing <!>")) ) (princ "\nSelect Mtexts to be replaced with Attributed Block <ROOMTAG> :") (setq sel (ssget "_:L" '((0 . "MTEXT")))) ) (progn (defun unformatmtext (string / text str) ;; ASMI - sub-function ;; ;; Get string from Formatted Mtext string ;; (setq text "") (while (/= string "") (cond ((wcmatch (strcase (setq str (substr string 1 2))) "\\[\\{}`~]" ) (setq string (substr string 3) text (strcat text str) ) ) ((wcmatch (substr string 1 1) "[{}]") (setq string (substr string 2)) ) ((and (wcmatch (strcase (substr string 1 2)) "\\P") (/= (substr string 3 1) " ") ) (setq string (substr string 3) text (strcat text " ") ) ) ((wcmatch (strcase (substr string 1 2)) "\\[LOP]") (setq string (substr string 3)) ) ((wcmatch (strcase (substr string 1 2)) "\\[ACFHQTW]") (setq string (substr string (+ 2 (vl-string-search ";" string)) ) ) ) ((wcmatch (strcase (substr string 1 2)) "\\S") (setq str (substr string 3 (- (vl-string-search ";" string) 2)) text (strcat text (vl-string-translate "#^\\" " " str)) string (substr string (+ 4 (strlen str))) ) (print str) ) (t (setq text (strcat text (substr string 1 1)) string (substr string 2) ) ) ) ) text ) (setq spc (vlax-get (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)) ) 'block ) ) (repeat (setq int (sslength sel)) (setq ent (ssname sel (setq int (1- int)))) (and (setq att (vla-insertblock spc (vlax-3d-point (cdr (assoc 10 (entget ent)))) bkn 1.0 1.0 1.0 0. ) ) (vl-some '(lambda (x) (if (eq (strcase (vla-get-tagstring x)) "ROOMNO") ;; change the tag name "ROOMNO" to suit yours (progn (vla-put-textstring x (unformatmtext (cdr (assoc 1 (entget ent)))) ) t ) ) ) (vlax-invoke att 'getattributes) ) (entdel ent) ) ) ) ) (princ) )(vl-load-com)
    1 point
  7. pkenewell nice idea very simple. Dahzee dont forget press F8 will force a H or V. F8 off / on etc.
    1 point
  8. All you really need to do is convert the selection set over to vla-object and pull the textstring value. with vla-get-property this strips out the formatting (like you linked) usually don't use mtext so my bad. on the coding. noticed my unhide command was missing a * so it was only finding text and not mtext. updated the code to only process the selection set once since everything is being converted over to vla-object names at the start then adding them to a list if a number is found in the string. processing the list at the end. Probably be negligible in time but it ends up being more effectuate. This will find any mtext and text with a number in HideTextwNumbers.lsp
    1 point
  9. Give this a try. (defun c:Test (/ sel int ent att spc) ;; Tharwat - Date: 19.Jun.2017 ;; (if (and (or (tblsearch "BLOCK" "ROOMTAG") (alert "Attributed Block <ROOMTAG> is not found in drawing <!>") ) (princ "\nSelect Mtexts to be replaced with Attributed Block <ROOMTAG> :") (setq sel (ssget "_:L" '((0 . "MTEXT")))) ) (progn (defun unformatmtext (string / text str) ;; ASMI - sub-function ;; ;; Get string from Formatted Mtext string ;; (setq text "") (while (/= string "") (cond ((wcmatch (strcase (setq str (substr string 1 2))) "\\[\\{}`~]" ) (setq string (substr string 3) text (strcat text str) ) ) ((wcmatch (substr string 1 1) "[{}]") (setq string (substr string 2)) ) ((and (wcmatch (strcase (substr string 1 2)) "\\P") (/= (substr string 3 1) " ") ) (setq string (substr string 3) text (strcat text " ") ) ) ((wcmatch (strcase (substr string 1 2)) "\\[LOP]") (setq string (substr string 3)) ) ((wcmatch (strcase (substr string 1 2)) "\\[ACFHQTW]") (setq string (substr string (+ 2 (vl-string-search ";" string)) ) ) ) ((wcmatch (strcase (substr string 1 2)) "\\S") (setq str (substr string 3 (- (vl-string-search ";" string) 2)) text (strcat text (vl-string-translate "#^\\" " " str)) string (substr string (+ 4 (strlen str))) ) (print str) ) (t (setq text (strcat text (substr string 1 1)) string (substr string 2) ) ) ) ) text ) (setq spc (vlax-get (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)) ) 'block ) ) (repeat (setq int (sslength sel)) (setq ent (ssname sel (setq int (1- int)))) (and (setq att (vla-insertblock spc (vlax-3d-point (cdr (assoc 10 (entget ent)))) "ROOMTAG" 1.0 1.0 1.0 0. ) ) (vl-some '(lambda (x) (if (eq (strcase (vla-get-tagstring x)) "ROOMNO") (progn (vla-put-textstring x (unformatmtext (cdr (assoc 1 (entget ent)))) ) t ) ) ) (vlax-invoke att 'getattributes) ) (entdel ent) ) ) ) ) (princ) )(vl-load-com)
    1 point
  10. Alright, here is what I am willing to do. I will leave my CAD computer on with CADTutor on my browser and AutoCAD up and running with the Oleson Village project drawing open. If you run into a real problem, and it is not later than 7:45 PM (our time) you can call me. After that time I am not available and my computer will be shut down for the evening. My day starts way too early to spend half the night walking you through the remainder of the project. Good luck. Time now is 7:00 PM.
    1 point
  11. I think if I actually knew how to put a benchmark on the model, It would make life easier. Just a guess. I know it seems like I haven't read anything, but I have. Everything seems chinese to me. You can read how to ride a bike for 5 years, but you don't know how to do it until you actually try it. I have put in serious hours just on the first few pages. Have you actually done this project?
    1 point
  12. Tests are done, now i have to complete the project to finish the course. The timing conflicts with my tuition reimbursement. My company is a multi-billion dollar company that just keeps taking from customers and their employees. I am in the very beginning. Table 2. I think i skipped the plot size, and a couple of other things. I hope it works out. I didn't even figure out the scaling. Anyways, i am new to this and i am a truly hands on learner, so if there are no video lessons then i am screwed. Lol
    1 point
  13. You live in Norwalk, CT? Would you be available for hire for a day? I just want to get the project done. I don't really have the time because my company has put strict deadlines on completing my course. Also, AUTOcad is not required for the job I am applying for. In the meantime, I will give it a shot, but I have less than two weeks to complete this project. All my other classes are pretty much finished. Thanks.
    1 point
  14. I guess CAB wouldn't mind... Attached. As I said, this is CAB's routine and I take no credit for it. The original thread is here: http://www.theswamp.org/index.php?topic=8855.0 PageSetups_CAB_06.LSP
    1 point
×
×
  • Create New...