LISP needed to delete text before or after a (~)

Anonymous · ‎08-30-2019

Is there a way to add attributes to this list?

I want this to work but i have to burst the block first then use the lisp created.

i want to select the block with attributes to work the same as selecting text strings im crossing my fingers!

LISP Routine Below:

Takes two arguments: A String to search for and a string to search in.
;; Usage: (charfind "ST" "TEST") ; This will return 3.
;;
;; Example: (if (> (setq pos (charfind "S" "TEST")) 0)(princ "Found the letter S at position: " . pos)(Princ "One or both search parameters was blank"))
;;
;; Return Values:
;; -1 = character not found within given string.
;; -2 = Search string is empty. (srch)
;; -4 = Test String is empty. (str)
;; -6 = Search String and Test String are both empty.

(defun strfind(srch str / pt pt2 cnt)
(setq cnt 0 pt 0 pt2 nil)
(if (EQ (strlen srch) 0) (setq pt -2))
(if (EQ (strlen str) 0) (setq pt (+ pt (- 0 4))))
(if (EQ pt 0)(setq pt -1))
(while (and (< pt 0) (> (strlen str) 0)(< cnt (strlen str)))
(if (eq srch (substr str (setq cnt (1+ cnt)) (strlen srch)))(setq pt cnt))
)
(setq pt2 pt)
)
(defun remTxt(ba)
(setq ent(ssget '(
(-4 . "<OR")
(0 . "TEXT")(0 . "MTEXT")
(-4 . "OR>")
))
)

(setq cnt -1)
(repeat (sslength ent)
(setq cent (entget (ssname ent (setq cnt (1+ cnt)))))
(setq cur (cdr(assoc 1 cent)))
(setq pos (strfind "~" cur))
(if (EQ ba 1)
(setq new (substr cur 1 (1- pos)))
(setq new (substr cur (1+ pos) (strlen cur)))
)
(setq cent(subst (cons 1 New) (cons 1 cur) cent))
(entmod cent)
)
)
(defun c:remA()
(remTxt 1)
)
(defun c:remB()
(remTxt 0)
)

dlanorh · ‎08-30-2019

Are you trying to remove a char or sub-string from a single text string, or a selection set (1+ text strings)?

If so you can do the find and replace at the same time.

I am not one of the robots you're looking for

Anonymous · ‎08-30-2019

Attached is a video of what the lisp does and i also included the DWG with the block that has attributes for testing.

we have material description with a kit code at the end of the description.

when project is done then im tasked to remove the kit codes after the material description.

The problem is that the lisp does not work with block that have attributes. i have to burst the block first to retain the text then run the lisp.

i want to keep the block as is, un-bursted

Example:

Before lisp:

1-10' SNGL TAN COMP XARM W/BRKT ~XA-HT-CMP-10-SG-1

After Lisp:

1-10' SNGL TAN COMP XARM W/BRKT

john.uhden · ‎08-30-2019

You don't have to burst any blocks.

If your function can take any textual object as input, then all you need to do to "fix" the attributes is something like this (I am at my wife's laptop without any AutoCAD, so I am sort of shooting from the hip here)...

Lets say object is a block insertion (reference).

(and
  (vla-has-attributes object)
  (vlax-for att (vla-get-attributes object)
    (do_your_thing att)
  )
)
Umm, I don't remember if vla-get-attributes returns a list,  If it does then
(foreach att (vla-get-attributes object)
  (do_your_thing att)
)

John F. Uhden

dlanorh · ‎08-30-2019

Try this. It automatically selects all Block References with attributes in the drawing and iterates through each attribute in each block removing everything from the "~" to the end.

WARNING: It unlocks all the layers so it can process all the block, then re-locks them. If you want this removed let me know.

Test it in a copy of a drawing first to make sure it works as you want it to.

(vl-load-com)
;Delete Kit Codes
(defun c:dkc ( / *error* c_doc sv_lst sv_vals lk_lst ss obj atts t_str pos)

  (defun *error* ( msg )
    (mapcar '(lambda (x) (vlax-put-property x 'lock :vlax-true)) lk_lst)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error occurred : " msg)))
    (princ)
  );end_defun *error*
  
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
        sv_lst (list 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst) 
  );end_setq
  
  (mapcar 'setvar sv_lst '(0 0))
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)

  (vlax-map-collection c_lyrs '(lambda (x) (cond ( (= :vlax-true (vlax-get-property x 'lock)) (vlax-put-property x 'lock :vlax-false) (setq lk_lst (cons x lk_lst))))))
  
  (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
  
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))
                  atts (vlax-invoke obj 'getattributes)
            );end_setq
            (foreach att atts
              (setq t_str (vlax-get-property att 'textstring)
                    pos (vl-string-search "~" t_str)
              );end_setq
              (cond (pos
                      (setq t_str (substr t_str 1 (1- pos)))
                      (vlax-put-property att 'textstring t_str)
                    )
              );end_cond
            );end_foreach
          );end_repeat
        )
        ( (princ "Nothing Found"))
  );end_cond

  (mapcar '(lambda (x) (vlax-put-property x 'lock :vlax-true)) lk_lst)
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

I am not one of the robots you're looking for

ronjonp · ‎08-30-2019

Perhaps this:

(defun c:foo (/ a i o str s)
  ;; RJP » 2019-08-30
  (if (and (progn (initget 0 "Before After")
		  (setq	a (cond	((getkword "\nRemove[Before/After]:<Before>"))
				("Before")
			  )
		  )
		  (setq	a (cond	((= "Before" a) '(substr str (+ 2 i)))
				('(substr str 1 (1- i)))
			  )
		  )
	   )
	   (setq s (ssget ":L"
			  '((-4 . "<OR")
			    (0 . "*TEXT")
			    (-4 . "<AND")
			    (0 . "INSERT")
			    (66 . 1)
			    (-4 . "AND>")
			    (-4 . "OR>")
			   )
		   )
	   )
      )
    (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq o (vlax-ename->vla-object x))
      (if (= "INSERT" (cdr (assoc 0 (entget x))))
	(foreach att (vlax-invoke o 'getattributes)
	  (if (setq i (vl-string-search "~" (setq str (vla-get-textstring att))))
	    (vla-put-textstring att (eval a))
	  )
	)
	(if (setq i (vl-string-search "~" (setq str (vla-get-textstring o))))
	  (vla-put-textstring o (eval a))
	)
      )
    )
  )
  (princ)
)

ronjonp · ‎08-30-2019

@dlanorh wrote:

Try this. It automatically selects all Block References with attributes in the drawing and iterates through each attribute in each block removing everything from the "~" to the end.

WARNING: It unlocks all the layers so it can process all the block, then re-locks them. If you want this removed let me know.

Test it in a copy of a drawing first to make sure it works as you want it to.

(vl-load-com)
;Delete Kit Codes
(defun c:dkc ( / *error* c_doc sv_lst sv_vals lk_lst ss obj atts t_str pos)

  (defun *error* ( msg )
    (mapcar '(lambda (x) (vlax-put-property x 'lock :vlax-true)) lk_lst)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error occurred : " msg)))
    (princ)
  );end_defun *error*
  
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
        sv_lst (list 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst) 
  );end_setq
  
  (mapcar 'setvar sv_lst '(0 0))
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)

  (vlax-map-collection c_lyrs '(lambda (x) (cond ( (= :vlax-true (vlax-get-property x 'lock)) (vlax-put-property x 'lock :vlax-false) (setq lk_lst (cons x lk_lst))))))
  
  (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
  
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))
                  atts (vlax-invoke obj 'getattributes)
            );end_setq
            (foreach att atts
              (setq t_str (vlax-get-property att 'textstring)
                    pos (vl-string-search "~" t_str)
              );end_setq
              (cond (pos
                      (setq t_str (substr t_str 1 (1- pos)))
                      (vlax-put-property att 'textstring t_str)
                    )
              );end_cond
            );end_foreach
          );end_repeat
        )
        ( (princ "Nothing Found"))
  );end_cond

  (mapcar '(lambda (x) (vlax-put-property x 'lock :vlax-true)) lk_lst)
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

@dlanorh FWIW You don't need to set undo marks or variables since no command calls ( a good thing as you know ) are in your loop and keep the locked selection intact since that would be expected behavior. Constructive criticism is all. 🙂

Anonymous · ‎09-03-2019

Works perfect

thanks!

ronjonp · ‎09-03-2019

@Anonymous wrote:
Works perfect
thanks!

Glad to help 🙂

Anonymous · ‎09-03-2019

hello again 🙂

i found a small hiccup.

the lisp will delete the letter in-front of the (~) if there is no space in-front of the ~

Example showing letter B is removed:

No space in-front;

1-10' SNGL XARM FB~ZOXA 331

1-10' SNGL XARM F

With one space or more is ok;

1-10' SNGL XARM FB ~ZOXA 331

1-10' SNGL XARM FB

ronjonp · ‎09-03-2019

The code assumes the data is consistent and was written based on your sample drawing. 😉

This should fix that but will leave a trailing space when " ~" is found.

(defun c:foo (/ a i o str s)
  ;; RJP » 2019-08-30
  (if (and (progn (initget 0 "Before After")
		  (setq	a (cond	((getkword "\nRemove[Before/After]:<Before>"))
				("Before")
			  )
		  )
		  (setq	a (cond	((= "Before" a) '(substr str (+ 2 i)))
				('(substr str 1 i))
			  )
		  )
	   )
	   (setq s (ssget ":L"
			  '((-4 . "<OR")
			    (0 . "*TEXT")
			    (-4 . "<AND")
			    (0 . "INSERT")
			    (66 . 1)
			    (-4 . "AND>")
			    (-4 . "OR>")
			   )
		   )
	   )
      )
    (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq o (vlax-ename->vla-object x))
      (if (= "INSERT" (cdr (assoc 0 (entget x))))
	(foreach att (vlax-invoke o 'getattributes)
	  (if (setq i (vl-string-search "~" (setq str (vla-get-textstring att))))
	    (vla-put-textstring att (eval a))
	  )
	)
	(if (setq i (vl-string-search "~" (setq str (vla-get-textstring o))))
	  (vla-put-textstring o (eval a))
	)
      )
    )
  )
  (princ)
)

Anonymous · ‎09-03-2019

that did the trick!

Sending Coffee your way! you earned it 🙂

ronjonp · ‎09-03-2019

@Anonymous wrote:
that did the trick!
Sending Coffee your way! you earned it 🙂

Cheers 🍻

john.uhden · ‎09-04-2019

Coffee? I think Kahlua has a longer shelf life. Well, that is until it's
opened.

John F. Uhden

Anonymous · ‎09-06-2019

Good Morning @ronjonp !

Can you help with this? or maybe shoot me into the right direction. i created a post but wasnt sure if that was the correct forum to post in. Can you take a look please. i need some help with a lisp modification

Thank you sir!

Post is here:

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/help-to-modify-polyinfo-lsp/td-p/900...

Community

LISP needed to delete text before or after a (~)

LISP needed to delete text before or after a (~)

LISP needed to delete text before or after a (~)