Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/14/2023 in all areas

  1. As far as I know I got out, definitely not perfect but got the base I wanted. With the code you all show here I can build in and embellish many options with OpenDCL. Thank you very much ! ;;; =================================================================================================== ;;; All Credits to Joe Burke - 3/2/2003 ;;; Modified by Leika Marchal 10/06/2022 ;;; Increment first number found in text or mtext object ;;; Other characters may precede number, "A-2" +2 returns "A-4" ;;; Works with reals and integers ;;; Options: increment copy multiple or increment existing text ;;; Cancel or Return to end ;;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-and-increment-text/td-p/840715 ;;; =================================================================================================== (defun c:IncrementText (/ *Error* Inc Ent Obj OldStr Mode NewStr OldNum Lst Res bpt nxpt) (defun *Error* (Msg) (cond ((or (not Msg) (member Msg '("console break" "Function cancelled" "quit / exit abort"))) ) (princ (strcat "\nError: " Msg)) ) (setvar "cmdecho" 1) (princ) ) (vl-load-com) ;by Michael Puckett ;retain characters contained in pattern within string (defun wcfilter ( string pattern / i c result ) (setq result "" i 0) (repeat (strlen string) (if (wcmatch (setq c (substr string (setq i (1+ i)) 1)) pattern ) (setq result (strcat result c)) ) ) result ) (setvar "cmdecho" 0) (defun PickTest () (setq Obj (entsel "\nSelect text to increment or Cancel to end: ")) (while (or (not Obj) (and (/= "MTEXT" (cdr (assoc 0 (entget (car Obj))))) (/= "TEXT" (cdr (assoc 0 (entget (car Obj))))) ) ) (setq Obj (entsel "\nText object not selected - try again: ")) ) ) (setq Inc (read (getstring "\nEnter increment value positive or negative: "))) (initget "Y N") ; Force User Input with (initget 1 "Y N ") (prompt "\n| ") (prompt "\n| Yes, will copy and add or subtract multiple times") (prompt "\n| No, will add or subtract existing text ") (prompt "\n| ") (prompt "\n| ") (princ) (setq Mode (getkword "\nCopy text [Yes/No] : ")) (if (= Mode "N") (progn (prompt "\n| ") (prompt "\n| ") (prompt "\n| ") (prompt "\n| Existing text will be edit ") (prompt "\n| ") (princ) (while (setq Obj (entsel "\nSelect text to edit <exit> : ")) (while (or (not Obj) (and (/= "MTEXT" (cdr (assoc 0 (entget (car Obj))))) (/= "TEXT" (cdr (assoc 0 (entget (car Obj))))) ) ) (setq Obj (entsel "\nText object not selected - try again: ")) ) (setq Ent (car Obj)) (setq Lst (entget Ent)) (setq OldStr (cdr (assoc 1 (entget Ent)))) (setq OldNum (read (wcfilter OldStr "[0-9 .]"))) (if (numberp OldNum) (progn (setq Res (+ Inc OldNum) Res (vl-princ-to-string Res) OldNum (vl-princ-to-string OldNum) NewStr (vl-string-subst Res OldNum OldStr 0) Lst (subst (cons 1 NewStr) (assoc 1 Lst) Lst) ) (entmod Lst) (entupd Ent) ) (princ "\nNumber not found in text object ") ) ) ) ) (if (= Mode "Y") (progn (PickTest) (setvar "lastpoint" (setq bpt (getpoint "\nBase point :"))) (while (setq nxpt (getpoint "\nEnter next point <exit> :" )) (if (null Ent) (progn (setq Ent (car Obj)) (command ".copy" Ent "" bpt nxpt) (setq Ent (entlast)) ) (progn (command ".copy" (entlast) "" (getvar "lastpoint") nxpt) (setq Ent (entlast)) ) ) (setq Lst (entget Ent)) (setq OldStr (cdr (assoc 1 (entget Ent)))) (setq OldNum (read (wcfilter OldStr "[0-9 .]"))) (if (numberp OldNum) (progn (setq Res (+ Inc OldNum) Res (vl-princ-to-string Res) OldNum (vl-princ-to-string OldNum) NewStr (vl-string-subst Res OldNum OldStr 0) Lst (subst (cons 1 NewStr) (assoc 1 Lst) Lst) ) (entmod Lst) (entupd Ent) ) (princ "\nNumber not found in text object ") ) ) ) ) (*Error* nil) (setvar "cmdecho" 1) (princ) ) ;shortcut ;(defun c:IT () (c:IncrementText)) (c:IncrementText)
    1 point
  2. Here is my attempt and please don't run the program on formatted Mtext otherwise you would get weird result. (defun c:test (/ sel ent str old new ltr obj get ins pt1 pt2 dis ent cpy tmp grr len lst) ;;------------------------------------------------------------;; ;; Author: Tharwat Al Choufi - Date: 09.Jun.2022 ;; ;; website: https://autolispprograms.wordpress.com ;; ;;------------------------------------------------------------;; (and (princ "\nPick on text ends with number : ") (setq sel (ssget "_+.:S:E:L" '((0 . "*TEXT") (1 . "*#")))) (setq ent (ssname sel 0) str (cdr (assoc 1 (entget ent))) old "" ) (while (not (numberp (read (setq ltr (substr str 1 1))))) (setq old (strcat old ltr) str (substr str 2) ) ) (setq str (read str) new str obj (vlax-ename->vla-object ent) ) (setq pt1 (getpoint "\nSpecify base point :")) (setq pt2 (getpoint "\nNew position :" pt1)) (setq dis (distance pt1 pt2)) (princ "\nMove your cursor far from text to copy text with increments < right click to exit > :") (while (eq (car (setq grr (grread t 14 0))) 5) (redraw) (and lst (progn (mapcar 'entdel lst) (setq lst nil) t)) (and (> (setq tmp 0.0 str new len (distance pt1 (cadr grr)) ) dis ) (repeat (fix (/ len dis)) (vlax-invoke (setq cpy (vla-copy obj)) 'Move pt1 (polar pt1 (angle pt1 pt2) (setq tmp (+ tmp dis))) ) (setq ent (vlax-vla-object->ename cpy) get (entget ent) get (entmod (subst (cons 1 (strcat old (vl-princ-to-string (setq str (1+ str))) ) ) (assoc 1 get) get ) ) lst (cons ent lst) ) ) ) ) ) (princ) ) (vl-load-com)
    1 point
  3. Yeah don't know why their are using two points as well. I guess it has to do with dxf 10 or 11 code based on justification. You only have to pick one point now and fixes your other problem @Leika you can now right click to exit. ;------------------------------------------------------------------------------------------- ;by Joe Burke - modified 3/2/2003 ;increment first number found in text or mtext object ;other characters may precede number, "A-2" +2 returns "A-4" ;works with reals and integers ;options: increment copy multiple or increment existing text ;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-and-increment-text/td-p/840715 (defun c:IncrementText (/ i Ent Obj OldStr Mode NewStr OldNum Lst Res Pt x xxx) (vl-load-com) ;by Michael Puckett ;retain characters contained in pattern within string (defun wcfilter (string pattern / i c result) (setq result "" i 0) (repeat (strlen string) (if (wcmatch (setq c (substr string (setq i (1+ i)) 1)) pattern ) (setq result (strcat result c)) ) ) result ) (defun PickTest () (setq Obj (car (entsel "\nSelect text to increment: "))) (while (or (not Obj) (and (/= "MTEXT" (cdr (assoc 0 (entget Obj)))) (/= "TEXT" (cdr (assoc 0 (entget Obj)))) ) ) (setq Obj (car (entsel "\nText object not selected - try again: "))) ) (if (eq (cdr (assoc 10 (entget Obj))) "0.0 0.0 0.0") (setq bpt (cdr (assoc 11 (entget Obj)))) (setq bpt (cdr (assoc 10 (entget Obj)))) ) ) (PickTest) (setq OldStr (cdr (assoc 1 (entget obj))) OldNum (read (wcfilter OldStr "[0-9 .]")) ) (if (numberp OldNum) (progn (setq NewNum (1+ OldNum) NewStr (vl-string-subst (itoa NewNum) (itoa OldNum) OldStr 0) ) ) (princ "\nNumber not found in text object ") ) (setq x (getpoint "\nBase point :")) (setq offset (mapcar '/ (mapcar '- bpt x))) (while (setq pt (mapcar '/ (mapcar '+ offset (getpoint "\nNext point: ")))) (entmake (list '(0 . "TEXT") (cons 10 pt) '(40 . 8.0) (cons 1 NewStr) ) ) (setq Newnum (1+ NewNum) NewStr (vl-string-subst (itoa NewNum) (itoa OldNum) OldStr 0) ) ) (princ) )
    1 point
  4. Try edited version ~'J'~ pipe.LSP
    1 point
×
×
  • Create New...