Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/26/2024 in all areas

  1. you could rewrite your while loops to : (while (and (> i 0) (not (wcmatch (substr textstring i 1) "#"))) (setq i (1- i))) (while (and (> i 0) (wcmatch (substr textstring i 1) "#")) (setq i (1- i))) this may fix some or all of your problems , it depends on the format of your texts. If your text ends with some letters you still have to append those too. for example (I disabled entsel and replaced it with a fix text) (defun c:IncrementTextNumber ( / ent entData textString i numEnd numStart numericPart numberValue newNumberValue newNumericPart newTextString ) ;(setq ent (car (entsel "\nSelect the text to increment: "))) ; Select the text entity (setq ent t) (if ent (progn ;(setq entData (entget ent)) ; Get the entity data ;(setq textString (cdr (assoc 1 entData))) ; Extract the text string ;;; *** testing (setq textString "123abc456def789ghi") ;; Find the position of the last numeric part (setq i (strlen textString)) ;(while (and (> i 0) (not (numberp (atoi (substr textString i 1))))) (setq i (1- i)) ) (while (and (> i 0) (not (wcmatch (substr textstring i 1) "#"))) (setq i (1- i))) ;; Find the start of the numeric part (setq numEnd i) ;(while (and (> i 0) (numberp (atoi (substr textString i 1)))) (setq i (1- i)) ) (while (and (> i 0) (wcmatch (substr textstring i 1) "#")) (setq i (1- i))) (setq numStart (+ i 1)) ;; Extract and increment the number (setq numericPart (substr textString numStart (- numEnd numStart -1))) (setq numberValue (atoi numericPart)) (setq newNumberValue (+ numberValue 1)) ;; Keep leading zeros (setq newNumericPart (rtos newNumberValue 2 0)) (while (< (strlen newNumericPart) (strlen numericPart)) (setq newNumericPart (strcat "0" newNumericPart)) ) ;; Replace the old number with the new number (setq newTextString (strcat (substr textString 1 (1- numStart)) newNumericPart)) (if (< numEnd (strlen textstring)) (setq newTextString (strcat newTextString (substr textString (1+ numEnd))))) ;| ;; Update the text in the drawing (entmod (subst (cons 1 newTextString) (assoc 1 entData) entData)) (entupd ent) |; (alert (strcat "Org. text : " (vl-princ-to-string textString) "\nNew text : " (vl-princ-to-string newTextString))) (princ "\nText updated successfully.") ) (princ "\nNo text selected.") ) (princ) ) (c:IncrementTextNumber)
    2 points
  2. Change the variable pdmode - there are description of what they are all, PDsize for point size... and of course, with any variable change set it back again after you are done with the LISP as required
    2 points
  3. You could also make sub abbreviated Lisps that calling the longer one. autocad does this with lots of commands like "circle" or just C for example. (defun C:ITN () (C:IncrementTextNumber)) (defun c:IncrementTextNumber () (setq ent (car (entsel "\nSelect the text to increment: "))) ; Select the text entity ....
    1 point
  4. I moved your thread to the AutoLISP, Visual LISP & DCL Forum. You can have the update automatic as you open a drawing by adding it to acaddoc.lsp (you may need to make one). Every one would need this in their own acaddoc.lsp or a network version could be used. Type at the commandline (findfile "acaddoc.lsp") to see if there already is one. Just add this... (command "DATALINKUPDATE" "_U" "_K") Per this article How to automatically update data links in AutoCAD (autodesk.com) You might prefer to use Excel and a VBA macro to update them - Update a table data link in AutoCAD using VBA - Stack Overflow Untested.
    1 point
  5. Thats ok what RLX has sent you should meet your needs.
    1 point
  6. If this might interest you, try this. This is for a metric system with multiple sizes of A4. The first use can be confusing, but don't hesitate to move the pointer, if you don't see anything change scale with the + or - keys, or zoom / zoom out with the wheel. Lines 157 and 158 can be commented out if you want to do other things with the data or continue with your own code... (defun des_vec (lst col / lst_sg) (setq lst_sg (list (cadr lst) (car lst))) (setq lst (cdr lst)) (while lst (if (cadr lst) (setq lst_sg (cons (cadr lst) (cons (car lst) lst_sg))) (setq lst_sg (cons (last lst_sg) (cons (car lst) lst_sg))) ) (setq lst (cdr lst)) ) (setq lst_sg (cons col lst_sg)) (grvecs lst_sg) ) (defun c:A4_dyn ( / unit_draw hview old_snapang pt_ins dx dy pt_tmp ang l_scale format_scale coeff key pt_key n nb_column nb_raw pt_row count s_ang) (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz"))) (progn (initget "KM ME CM MM") (if (not(setq unit_draw (getkword "\nDrawing made in [KM/ME/CM/MM] <ME>: "))) (setq unit_draw "ME") ) (cond ((eq unit_draw "KM") (setq unit_draw 1000000) ) ((eq unit_draw "ME") (setq unit_draw 1000) ) ((eq unit_draw "CM") (setq unit_draw 10) ) ((eq unit_draw "MM") (setq unit_draw 1) ) ) (setvar "USERS5" (strcat "qz" (itoa unit_draw))) ) (setq unit_draw (atoi (substr (getvar "USERS5") 3))) ) (setq hview (getvar "VIEWSIZE") old_snapang (getvar "SNAPANG") pt_ins (list (- (car (getvar "VIEWCTR")) (* hview 0.5)) (- (cadr (getvar "VIEWCTR")) (* hview 0.5))) dx 210.0 dy (* 210.0 (sqrt 2)) pt_tmp pt_ins ang (getvar "SNAPANG") l_scale '(1.0 1.25 2.0 2.5 5.0 7.5) format_scale (car l_scale) coeff 1.0 ) (if (> (fix (/ hview dy)) 3) (while (> (fix (/ hview dy)) 3) (foreach value l_scale (if (> (fix (/ hview dy)) 3) (setq format_scale value dx (* 210.0 format_scale) dy (* 210.0 (sqrt 2) format_scale)) ) ) (if (> (fix (/ hview dy)) 3) (setq coeff (* coeff 10.0) l_scale (mapcar '(lambda (x) (* x coeff)) l_scale) format_scale (car l_scale) ) ) ) ) (if (< (fix (/ hview dy)) 1) (while (< (fix (/ hview dy)) 1) (foreach value (reverse l_scale) (if (< (fix (/ hview dy)) 1) (setq format_scale value dx (* 210.0 format_scale) dy (* 210.0 (sqrt 2) format_scale)) ) ) (if (< (fix (/ hview dy)) 1) (setq coeff (* coeff 0.1) l_scale (mapcar '(lambda (x) (* x coeff)) l_scale) format_scale (last l_scale) ) ) ) ) (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale <" (rtos (* unit_draw format_scale) 2 3) ">: ")) (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (setq pt_key (cadr key)) (setq n (* (setq nb_column (fix (/ (+ (* (- (car pt_key) (car pt_ins)) (cos ang)) (* (- (cadr pt_key) (cadr pt_ins)) (sin ang))) dx))) (setq nb_raw (fix (/ (- (* (- (cadr pt_key) (cadr pt_ins)) (cos ang)) (* (- (car pt_key) (car pt_ins)) (sin ang))) dy))) ) pt_row pt_ins count 0 ) (redraw) (repeat n (des_vec (list (list (car pt_ins) (cadr pt_ins)) (list (+ (car pt_ins) (* dx (cos ang))) (+ (cadr pt_ins) (* dx (sin ang)))) (setvar "LASTPOINT" (list (+ (car pt_ins) (- (* dx (cos ang)) (* dy (sin ang)))) (+ (cadr pt_ins) (+ (* dy (cos ang)) (* dx (sin ang)))) ) ) (list (- (car pt_ins) (* dy (sin ang))) (+ (cadr pt_ins) (* dy (cos ang)))) ) 3 ) (setq count (1+ count)) (if (< count nb_column) (setq pt_ins (list (+ (car pt_ins) (* dx (cos ang))) (+ (cadr pt_ins) (* dx (sin ang))))) (setq pt_ins (list (- (car pt_row) (* dy (sin ang))) (+ (cadr pt_row) (* dy (cos ang)))) pt_row pt_ins count 0) ) ) (setq pt_ins pt_tmp) ) ((or (eq (cadr key) 114) (eq (cadr key) 82)) (initget 0) (setq s_ang (getorient pt_ins (strcat "\nNew angle<" (angtos (getvar "SNAPANG")) ">: " ) ) ) (if (not s_ang) (setq s_ang ang)) (if (and (> s_ang (/ pi 2)) (<= s_ang (/ (* 3 pi) 2))) (setq ang (+ s_ang pi)) (setq ang s_ang) ) (setvar "SNAPANG" ang) (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale" (rtos (* unit_draw format_scale) 2 3) ">: ")) ) ((or (eq (cadr key) 109) (eq (cadr key) 77)) (initget 9) (setq pt_ins (getpoint "\nSpecify the bottom left corner: ")) (setq pt_ins (list (car pt_ins) (cadr pt_ins)) pt_tmp pt_ins) (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale <" (rtos (* unit_draw format_scale) 2 3) ">: ")) ) ((eq (cadr key) 43) (setq format_scale (cadr (member format_scale l_scale))) (if (not format_scale) (setq format_scale (car (setq l_scale (mapcar '(lambda (x) (* x 10.0)) l_scale))))) (setq dx (* 210.0 format_scale) dy (* 210.0 (sqrt 2) format_scale)) (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale <" (rtos (* unit_draw format_scale) 2 3) ">: ")) ) ((eq (cadr key) 45) (setq format_scale (cadr (member format_scale (reverse l_scale)))) (if (not format_scale) (setq format_scale (last (setq l_scale (mapcar '(lambda (x) (* x 0.1)) l_scale))))) (setq dx (* 210.0 format_scale) dy (* 210.0 (sqrt 2) format_scale)) (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale <" (rtos (* unit_draw format_scale) 2 3) ">: ")) ) ) ) (princ "\n") (redraw) (princ (setq toto (list (list pt_ins (getvar "LASTPOINT")) (getvar "SNAPANG") (* unit_draw format_scale)))) (command "_.rectang" "_none" (caar toto) "_rotation" (angtos (getvar "SNAPANG")) "_none" (cadar toto)) (setvar "SNAPANG" old_snapang) (prin1) )
    1 point
  7. It's an express tool? Might also need to add in " " either side of the file paths REDIR;"P:\\Sjablonen";"F:\\7 - Sjablonen\\Logo's";
    1 point
  8. Try this one and if ok can use table to excel. table to excel.lsp COT_Convert_Old_Table-V1.6a.lsp
    1 point
  9. @C. RobertsOK - Updated version with @ronjonp's edit: ;; Function to search the Block Library using a wildcard match. ;; returns a list of the block names matching [pat]. ;; 8/22/2024 Thanks RONJONP for the edit to make it shorter (defun pjk-blockfind (pat / bl) (vl-load-com) (vlax-for x (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (and (wcmatch (vla-get-name x) pat) (setq bl (cons (vla-get-name x) bl))) ) bl ) ; conditional test for block names "ANCHOR", "RNOTES", and search for and "DTBLK" with 1 or 2 Alpha chracters on the end. ; note - it could just be "DTBLK*" in the match pattern if it doesn't matter what the suffix is. (cond ( (and (tblsearch "BLOCK" "ANCHOR") (tblsearch "BLOCK" "RNOTES") (> (length (pjk-BlockFind "DTBLK@, DTBLK@@")) 0) ) (princ "\nAll qualified blocks were found. ") ) )
    1 point
×
×
  • Create New...