Leaderboard
Popular Content
Showing content with the highest reputation on 04/24/2025 in Posts
-
Hi In this new version, it's possible to enter the text before the first text you want to insert from the keyboard or, as before, select it on the screen. Additionally, it will now increment numeric, alphabetic, or alphanumeric text strings without any restrictions (except for non-alphanumeric characters, of course). @leonucadomi As for your suggestion to extend the code's functionality to block attributes, I may do something about this in the future. However, I'm sure there must be simpler routines that would do the job just as well. There are several block experts on this forum who will probably have something to say about this. But if not, I'll try to do it myself. ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:txtIncrem (/ tam capa ind para a c cl txsel le l s dameTexto obtcad ent loc tipC nC ps add errores error0 ) (defun errores (mens) (setq *error* error0) (prin1) ) (defun dameTexto (cad / v r l daleVuelta) ;;; WRITE HERE THE CODE YOU NEED TO CUSTOMIZE THE TEXT YOU WANT TO ENTER OR CREATE (defun daleVuelta (a) (cond ((and (> a 64) (< a 91)) (if (> (setq a (+ a 1)) 90) (setq a -65) a)) ((and (> a 96) (< a 123)) (if (> (setq a (+ a 1)) 122) (setq a -97) a)) ((and (> a 47) (< a 58)) (if (> (setq a (+ a 1)) 57) (setq a -48) a)) ) ) (foreach v (reverse (vl-string->list cad)) (if (or (not r) (minusp r)) (setq l (cons (abs (setq r (daleVuelta v))) l)) (setq l (cons v l)) ) ) (vl-list->string (if (minusp r) (cons (if (= r -48) 49 (car l)) l) l)) ) (setq error0 *error* *error* errores ) (princ (setq s "Select PREVIOUS number text or type it... ")) (while (not para) (setq l (grread T 13 2)) (if (not (listp (cadr l))) (if (member (car l) '(2 3 11 25)) (cond ((or (= (cadr l) 13) (= (car l) 25)) (if (and c (not (wcmatch c "*.*"))) (setq ind c para T) (if (not c) (setq para T)) ) ) ((> (cadr l) 31) (setq c (if c (strcat c (chr (cadr l))) (chr (cadr l)))) (prompt (strcat "\r" s c)) ) ((= (cadr l) 8) (if (setq c (if c (substr c 1 (- (strlen c) 1)))) (prompt (strcat "\r" s c)) ) ) ) ) (if (= (car l) 3) (if (and (setq e (nentselp (cadr l))) (= (cdr (assoc 0 (setq le (entget (setq e (car e)))))) "TEXT")) (if (not (wcmatch (setq ind (cdr (assoc 1 le))) "*.*")) (setq capa (cdr (assoc 8 le)) a (cdr (assoc 40 le)) cl (cdr (assoc 62 le)) para T) (princ "\n*** The selected object is not valid. Please, try again... ***") ) ) ) ) ) (setq para nil) (if (not capa) (while (not para) (if (and (setq e (car (entsel "\nLAYER/HEIGHT: Select a sample text object (ENTER or RIGHT CLICK to type it)... "))) (setq l (entget e)) ) (if (= (cdr (assoc 0 l)) "TEXT") (setq capa (cdr (assoc 8 l)) a (cdr (assoc 40 l)) para T) (princ "\n*** The selected object is not a TEXT. Please, try again... ***") ) (if (not capa) (if (setq capa (getstring "\nType Layer name: ")) (if (tblsearch "layer" capa) (if (not (setq a (getreal "\nType Height: "))) (setq capa (princ "\n*** A valid height has not been specified. Please, type it again... ***") capa nil) (setq para T) ) (setq capa (princ "\n*** Specified layer does not exist. Please, type it again... ***") capa nil) ) ) ) ) ) ) (setq tx (dameTexto ind)) (while (and (setq l (grread T (if s 4 13) (if s 2 0))) (member (car l) '(5 3))) (prompt (strcat "\rSelect text to modify or insert new text \"" tx "\" (RIGHT CLICK for exit)")) (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))) para nil) (if (setq s (ssget "_C" (list (- (car (setq p (cadr l))) tam) (- (cadr p) tam)) (list (+ (car p) tam) (+ (cadr p) tam)) (list (cons 0 "TEXT")) ) ) (cond ((= (car l) 3) (entmod (subst (cons 1 tx) (assoc 1 (setq le (entget (ssname s 0)))) le)) (setq tx (dameTexto tx)) ) ;;; HERE MORE CASES ?... ) (cond ((= (car l) 3) (entmake (list '(0 . "TEXT") (cons 8 capa) (cons 62 (if cl cl 256)) (cons 40 a) (cons 1 tx) (cons 10 (list (car p) (cadr p) 0.0)) ) ) (setq tx (dameTexto tx)) ) ;;; HERE MORE CASES ?... ) ) ) (princ) )1 point
-
Welcome to CADTutor! I have moved your thread to the CAD Management Forum. Please post in the most appropriate Forum. All of your links but the last one are dead ends. I use similar to this when I do Architecture drawings or usually when I use AutoCAD Architecture, I use the layers that it creates for which objects I am creating. Standard CAD Layers for Architectural Drawings Are you using AutoCAD Architecture or just vanilla AutoCAD?1 point
-
Update to above: Looking at this with CAD running this morning. For my code above you need to 'entmake' the block entities within the block definition part rather than draw them - possible to do but you don't get the graphical view on the screen what you are doing. Switched it around to select the entities first, copy them within the block definition then delete the originals once the block is created. Insert the block using entmake method - a bit neater I think to make a block on a set layer - rather than altering the drawing layer settings and back or inserting a block and then switching the layer after. You can add any entities you like to the block or adjust the (ssget) part to filter as required. I've put the 'fixed' details like block name as separate variables - it is possible to have user inputs here for some versatility. (defun c:test ( / MySS acount MyBlockName Origin MyLayer) (setq MySS (ssget)) ;;Select entities to convert to a block (setq MyBlockName "Retaining_Wall") ;;Block Name, change as required. Could use uaser input for block name (setq Origin (getpoint "Select Block Origin")) ;;Block origin,alter as required. Could hard code this to say (0 0 0) (setq MyLayer "RetainingWall") ;;Layer Name. Could use user input for layer name (setq LayerColour 1) ;;Layer Colour. (if (not (tblsearch "LAYER" MyLayer)) (command "-LAYER" "_M" MyLayer "_C" LayerColour MyLayer "")) ;; Create layer if necessary (setq NewBlock (entmakex (list (cons 0 "BLOCK") (cons 2 MyBlockName) (cons 70 64) (cons 10 Origin) )) ) ;;Start block definition (setq acount 0) ;; A counter (while (< acount (sslength MySS)) ;; make entities withn block (entmake (entget (ssname MySS acount))) ;; Remake entity within block (setq acount (+ acount 1)) ) ; end while (setq EndBlock (entmakex '((0 . "ENDBLK"))) ) ;;Finish Block definition (command "erase" MySS "") ;;Delete original objects, comment out if not required (entmakex (list (cons 0 "INSERT") (cons 67 0) (cons 100 "AcDbEntity") ;; insert the block (cons 8 MyLayer) ;;Use layer here, no need to set current layer settings in drawing (cons 100 "AcDbBlockReference") (cons 2 MyBlockName) (cons 10 Origin) (cons 41 1.0) (cons 42 1.0) (cons 43 1.0) (cons 50 0.0) (cons 70 0) (cons 71 0) (cons 44 0.0) (cons 45 0.0) )) (command "regen") ;; Regen Drawing (princ) )1 point
-
Easter Sunday, CAD is off but extracting, copy and paste with no testing I think this is kind of what you are looking to add into a code: Things like escape will escape the full LISP where as finishing entity like polyline with enter will let it continues as it should. Can add in details to create the block at a specific layer - add the 'cons 8' example fuccaro above, but first see if this works. Technique is to create the block, then the entities and then finish the block (setq MyBlockName "Retaining_Wall") ;;Block Name, change as required (setq origin (list 0 0 0)) ;;Block origin,alter as required (entmake (list '(0 . "BLOCK") (cons 2 MyBlockName) (cons 70 64) (cons 10 origin) )) ;;Start block definition ;;Create the block entities here: (command "PLINE") ;;..... ;;Finish block entities. (entmakex '((0 . "ENDBLK"))) ;;Finish Block definition (setq NewBlock (tblobjname "BLOCK" MyBlockName)) ; entity description of new block. Think could also use (entlast) ? (command "-insert" NewBlock pause "" 1 pause) ;; Insert block, scale 1. 'NewBlock' might be MyBlockName ?1 point
-
Based on the answers given so far, it's possible I haven't fully understood your question. But I'll answer it anyway. If you want to interactively view the block to be inserted during the insertion process, you should first check if the command offers that option during execution: type '(command "_insert" "RetainingWall")' on the command line and add parameters to see if the command's behavior suits your needs. If not, then you can resort to a safer solution: the "move" command. The idea is to first insert the block at point 0,0 and call "(command "_move" (entlast) '(0 0))" And... voilà: you'll have the block visible at your cursor, waiting for you to tell it where to place it.1 point
-
Just a small hint: If you create the polyline vith entmake, just put something like (cons 8 "RetainingWall"). It will put the polyline on the desired layer if that layer exists and it will create it if it doesen't. Also I vould use a shorter name for the program name.1 point