Leaderboard

Type appload this should pop up load style.lsp into the startup suit. contains above code. style.lsp

This matches above. yes is for the backwards being checked. change to "" if not needed to be backwards (vl-cmdf "_.Style" "Kateb NaskhD" "naskhd" "" "" "" "Yes" "" "") Add to a lisp that is in your startup suite at is loaded on load.

probably could do this easier with lambda but this gets the job done. (defun LIST-COUNT (lst match / lst-match result) (vl-load-com) (foreach x lst ;for each item in list (if (eq (vl-symbol-name (cadr x)) match) ;if 2nd item in mini list match what your looking for (setq lst-match (cons (substr (vl-symbol-name (car x)) 1 4) lst-match)) ;add first item in mini list first 4 letters to a new list ) ) (foreach x lst-match ;step thought each match and count them (setq Result (if (setq Item (assoc x Result)) ;if match is in results list (subst (cons x (1+ (cdr Item))) Item Result) ;1+ to the count (cons (cons x 1) Result) ;add new item to the results list with a count of 1 ) ) ) Result ) Results (list-count list-name "TRUE") (("H601" . 32) ("H602" . 32) ("H603" . 32)) (list-count list-name "FALSE") (("H603" . 12)) --edit O you want whats the % off true in the list. will take a little more calculations one sec.

Just an update , the test replace did work ,but not on all the mtext ,I just used the textreplacefunc in you LISP. My in input was OLD text:DHL Splitter 1:32 New Text:asdasdsads Splitters Ideally it should have changed all the texts

Glad to see you posting Lee

Since the string to be found is already being passed an argument to your function, you can 'hardcode' it by simply defining another function which evaluates your function with a hardcoded string, e.g.: (defun c:test ( ) (chkmtxtstr "MyTextString") ) Though, if you're happy with a case-sensitive match and assuming the MText content has no formatting and does not straddle multiple DXF group 3 entries, the code can become much simpler - consider the following: (defun find ( str ) (ssget "_X" (list '(0 . "MTEXT") (cons 1 (strcat "*" str "*")))) ) Since the above will return a selection set, you can call it in the following way: (defun c:test ( / sel ) (if (setq sel (find "YourString")) (command "_.change" sel "" "_p" "_la" "0" "_c" "ByLayer" "") ) (princ) )

That's what I thought you were doing, I have this AttNorm, mostly every object in a block will be set to be ByBlock and layer 0, saves having to explode blocks. If a line in the block is set to a colour it will change that. If the block contains other blocks though, it won't change them, any lines in them will stay the same. As it is it will also change the layers of every object in the block to layer 0, but you can ;; that out in the code Final note is that I didn't make this up, copied it when I was first looking at LISPs and haven't referenced where I got it from, if it anyones then thanks, I use it a lot and more than happy to make a note to reference the original author Last final note... perhaps this is a long way to do this but it mostly works for me, not needed to do anything else yet Look near the end what to do just to change the colour (defun c:attnorm (/ myblocklayer myblockcolour myblocklineweight myblocklinetype) ;;Sets block to layer 0, by layer and so on (setq myblocklayer "0") (setq myblockcolour 0) (setq myblocklineweight aclnwtbyblock) (setq myblocklinetype "byblock") (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype) (princ) ) (defun c:attnormgrey (/ myblocklayer myblockcolour myblocklineweight myblocklinetype) ;; As Attnorm but sets the colour to grey (253) (setq myblocklayer "0") (setq myblockcolour 253) (setq myblocklineweight aclnwtbyblock) (setq myblocklinetype "byblock") (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype) (princ) ) (defun c:attnormcolour (/ myblocklayer myblockcolour myblocklineweight myblocklinetype) ;;as above but asks for the olour to use (setq myblocklayer "0") (setq myblockcolour (getint "Enter Colour Code Value (0 - 249)(253: Grey) ")) (setq myblocklineweight aclnwtbyblock) (setq myblocklinetype "byblock") (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun mynorm (myblocklayer myblockcolour myblocklineweight myblocklinetype / *error* adoc lst_layer func_restore-layers) (defun *error* (msg) (func_restore-layers) (vla-endundomark adoc) (princ msg) (princ) ) ;_ end of defun (defun func_restore-layers () (foreach item lst_layer (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vl-catch-all-apply '(lambda () (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))) ) ;_ end of vla-put-freeze ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of foreach ) ;_ end of defun (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))) ) ;_ end of vla-startundomark (if (and (not (vl-catch-all-error-p (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "INSERT"))) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of vl-catch-all-error-p ) ;_ end of not selset ) ;_ end of and (progn (vlax-for item (vla-get-layers adoc) (setq lst_layer (cons (list item (cons "lock" (vla-get-lock item)) (cons "freeze" (vla-get-freeze item)) ) ;_ end of list lst_layer ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)) ) ;_ end of vl-catch-all-apply ) ;_ end of vlax-for (foreach blk_def (mapcar (function (lambda (x) (vla-item (vla-get-blocks adoc) x) ) ;_ end of lambda ) ;_ end of function ((lambda (/ res) (foreach item (mapcar (function (lambda (x) (vla-get-name (vlax-ename->vla-object x) ) ;_ end of vla-get-name ) ;_ end of lambda ) ;_ end of function ((lambda (/ tab item) (repeat (setq tab nil item (sslength selset) ) ;_ end setq (setq tab (cons (ssname selset (setq item (1- item)) ) ;_ end of ssname tab ) ;_ end of cons ) ;_ end of setq ) ;_ end of repeat tab ) ;_ end of lambda ) ) ;_ end of mapcar (if (not (member item res)) (setq res (cons item res)) ) ;_ end of if ) ;_ end of foreach (reverse res) ) ;_ end of lambda ) ) ;_ end of mapcar (vlax-for ent blk_def ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Sets the block attributes ;;add in here other attributes to change (vla-put-layer ent myblocklayer) ;;;;;;;Hide this one away if you want to retain layers (vla-put-color ent myblockcolour) ;;;;;;;Colours (vla-put-lineweight ent myblocklineweight) ;;;;;;;Sets lineweight, hide if not needed ;; (vla-put-linetype ent myblocklinetype) ;;end of setting up block attributes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ) ;_ end of vlax-for ) ;_ end of foreach (func_restore-layers) (vla-regen adoc acallviewports) ) ;_ end of progn ) ;_ end of if (vla-endundomark adoc) (princ) ) ;_ end of defun ;;------------------------------------------------------------;; ;; End of File ;; ;;------------------------------------------------------------;;

Upper Left = tag text 1 + each number text has 1 number Upper Right = tag text 1 + 1 number text has 2 numbers, get first number and print to prompt Lower Left = tag text 2 case, combine with comma Lower Right = countext2, countext with expression (vl-load-com) (defun c:countext ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt ) (setq tot 0.0) (setq tagtxt "") (setq ans "") (setq texpression "=") (while (= ans "") (setq ss (ssget ":L" '((0 . "TEXT")))) (setq el (entget (ssname ss 0))) (repeat (setq x (sslength ss)) (setq en (ssname ss (setq x (1- x)))) (setq val (cdr (assoc 1 (entget en)))) (setq val2 (LM:parsenumbers val)) (setq val2len (length val2)) (cond ((= val2len 0) (if (= (strlen tagtxt) 0) (setq tagtxt (strcat tagtxt (vl-princ-to-string val))) (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val))) ) (vla-delete (vlax-ename->vla-object en)) ) ((= val2len 1) (setq tot (+ tot (car val2))) (if (= (strlen texpression) 1) (setq texpression (strcat texpression (vl-princ-to-string (car val2)))) (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2)))) ) (vla-delete (vlax-ename->vla-object en)) ) ((> val2len 1) (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ") (princ val2) (setq tot (+ tot (car val2))) (if (= (strlen texpression) 1) (setq texpression (strcat texpression (vl-princ-to-string (car val2)))) (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2)))) ) (vla-delete (vlax-ename->vla-object en)) ) ) ) (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>")) ) (princ "\n finished, result is = ") (princ tot) (princ "\n in expression = ") (princ texpression) (setq pt (getpoint "\nSelect Total Insertion Point : ")) (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))) (setq resulttxt (strcat tagtxt " - " txt)) (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) ) (princ) ) (defun c:countext2 ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt ) (setq tot 0.0) (setq tagtxt "") (setq ans "") (setq texpression "=") (while (= ans "") (setq ss (ssget ":L" '((0 . "TEXT")))) (setq el (entget (ssname ss 0))) (repeat (setq x (sslength ss)) (setq en (ssname ss (setq x (1- x)))) (setq val (cdr (assoc 1 (entget en)))) (setq val2 (LM:parsenumbers val)) (setq val2len (length val2)) (cond ((= val2len 0) (if (= (strlen tagtxt) 0) (setq tagtxt (strcat tagtxt (vl-princ-to-string val))) (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val))) ) (vla-delete (vlax-ename->vla-object en)) ) ((= val2len 1) (setq tot (+ tot (car val2))) (if (= (strlen texpression) 1) (setq texpression (strcat texpression (vl-princ-to-string (car val2)))) (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2)))) ) (vla-delete (vlax-ename->vla-object en)) ) ((> val2len 1) (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ") (princ val2) (setq tot (+ tot (car val2))) (if (= (strlen texpression) 1) (setq texpression (strcat texpression (vl-princ-to-string (car val2)))) (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2)))) ) (vla-delete (vlax-ename->vla-object en)) ) ) ) (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>")) ) (princ "\n finished, result is = ") (princ tot) (princ "\n in expression ") (princ texpression) (setq pt (getpoint "\nSelect Total Insertion Point : ")) (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))) (setq resulttxt (strcat tagtxt " - " txt)) (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) ) (rh:em_txt (list (car pt) (- (cadr pt) (* 2 (cdr (assoc 40 el)))) (caddr pt)) texpression (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) ) (princ) ) (defun rh:em_txt ( pt txt lyr sty tht xsf) (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf)) );end_list );end_entmakex );end_defun ;; Parse Numbers - Lee Mac ;; Parses a list of numerical values from a supplied string. (defun LM:parsenumbers ( str ) ( (lambda ( l ) (read (strcat "(" (vl-list->string (mapcar '(lambda ( a b c ) (if (or (< 47 b 58) (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) (and (= 46 b) (< 47 a 58) (< 47 c 58)) ) b 32 ) ) (cons nil l) l (append (cdr l) '(())) ) ) ")" ) ) ) (vl-string->list str) ) ) how about this countext - only result countext2 - with expression

See how to use groups: quickly tested though) (vl-load-com) (defun C:demo (/ elist en string regex result) (setq string (cdr (assoc 1 (setq elist (entget (setq en (car (entsel "\n\t>> Select dimension with tolerance: ")))))))) (setq regex (vlax-create-object "Vbscript.RegExp")) (vlax-put-property regex "IgnoreCase" 0) (vlax-put-property regex "Global" 1) (vlax-put-property regex "Pattern" "(.\\\\[s])(.*?)(\\^)(.*?);(.*?)") (setq result (vlax-invoke-method regex "Replace" string (strcat "$1" "+0.00125" "$3" "-0.0025" "$5;")));<--build replacement here (vlax-release-object regex) (entmod (subst (cons 1 result) (assoc 1 elist) elist)) (entupd en) (princ) ) ~'J'~