Leaderboard

however... quite aggressive asking for the credit here today. Nicer ways to go "Hey, this was originally my code, can you credit me" and perhaps if possible the link to the original code to help the OP out. Code gets shared, the links and credits lost. Always good practice to add links to the sources and credits in case there are thing you want to go back and understand more from any discussions. Having said that though, upload code, you have no control of it's use and I am not sure I'd want credited with a base code that is mine and then heavily modified, or just a snippet of my code included in something larger without me doing checks and testing.

@EIA You can use a dynamic block. А-А.dwg

Why not something different...? ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:txtIncrem (/ tam capa ind para a txsel lstent le l s dameTexto errores error0) (defun errores (mens) (setq *error* error0) (prin1) ) (defun dameTexto (/ tx) ;;; WRITE HERE THE CODE YOU NEED TO CUSTOMIZE THE TEXT YOU WANT TO ENTER OR CREATE (cond ((= (strlen (setq tx (itoa (setq ind (+ ind 1))))) 1) (strcat "00" tx) ) ((= (strlen tx) 2) (strcat "0" tx) ) (T tx) ) ) (while (not para) (if (setq ent (car (entsel "\nSelect index text..."))) (if (= (cdr (assoc 0 (setq lstent (entget ent)))) "TEXT") (if (wcmatch (setq ind (cdr (assoc 1 lstent))) "#,##,###,####") (setq ind (atoi ind) capa (cdr (assoc 8 lstent)) a (cdr (assoc 40 lstent)) para T) (princ "\n*** The selected object is not valid. Please, try again... ***") ) ) (setq para T) ) ) (setq error0 *error* *error* errores ) (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))) para nil) (princ "\nSelect text to modify or insert new text (RIGHT CLICK for exit)...") (while (and (setq l (grread T (if s 4 13) (if s 2 0))) (member (car l) '(5 3))) (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 (dameTexto)) (assoc 1 (setq le (entget (ssname s 0)))) le)) ) ;Here are other possible cases ) (cond ((= (car l) 3) (entmake (list '(0 . "TEXT") (cons 8 capa) (cons 40 a) (cons 1 (dameTexto)) (cons 10 (list (car p) (cadr p) 0.0)) ) ) ) ;Here are other possible cases ) ) ) (princ) )

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) )

from pyrx import Rx, Ge, Gi, Gs, Db, Ap, Ed, Ax import traceback import wx # wxPython import openpyxl as xl from openpyxl.drawing.image import Image as xlImage from openpyxl.utils.cell import get_column_letter @Ap.Command() def doit(): try: db = Db.curDb() ps, id, _ = Ed.Editor.entSel("\nSelect a table: ", Db.Table.desc()) if ps != Ed.PromptStatus.eOk: raise RuntimeError("Selection Error! {}: ".format(ps)) wb = xl.Workbook() ws = wb.active table = Db.Table(id) opts = Db.TableIteratorOption.kTableIteratorSkipMerged for cell in table.cells(opts): if table.cellType(cell.row, cell.column) == Db.CellType.kBlockCell: blk = table.blockTableRecordId(cell.row, cell.column) img: wx.Image = Gs.Core.getBlockImage(blk, 64, 64, 1.0, [0, 0, 0]) img.SetMaskColour(0, 0, 0) img.SetMask(True) imgpath = "E:\\temp\\Icons\\{}.png".format(blk.handle()) img.SaveFile(imgpath, wx.BITMAP_TYPE_PNG) xlimg = xlImage(imgpath) xlimg.width = 64 xlimg.height = 64 cellref = "{}{}".format(get_column_letter(cell.column + 1), cell.row + 1) ws.add_image(xlimg, cellref) else: ws.cell( row=cell.row + 1, column=cell.column + 1, value=table.textString(cell.row, cell.column), ) wb.save("E:\\temp\\logo.xlsx") except Exception as err: traceback.print_exception(err)

(defun c:GLVScopi (/ cj cj1 n e mx my para) (if (setq cj (ssget '((0 . "*TEXT")))) (while (not para) (setq cj1 (ssadd)) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (setq tx (cdr (assoc 1 (setq l (entget e)))) mx (if mx (min (cadr (assoc 10 l)) mx) (cadr (assoc 10 l))) my (if my (min (caddr (assoc 10 l)) my) (caddr (assoc 10 l))) ) (entmake (subst (cons 1 (strcat (chr (+ (ascii (substr tx 1 1)) 1)) (substr tx 2))) (assoc 1 l) l)) (ssadd (entlast) cj1) ) (command "_move" cj1 "" (list mx my)) (setq cj cj1 cj1 nil n nil mx nil my nil) ) ) (princ) ) @Ish I edited it from my smartphone, so I couldn't test it. Check it yourself if it works.

I'll update all of this to also allow you to enter the initial reference number from the keyboard, as @Nikon wanted. I'll post it soon.

Sorry, I noticed your running BricsCAD 2021? If so, I’m sorry to say only v24-v25 is supported. Or maybe you forgot to update your profile? 1, head over to https://github.com/CEXT-Dan/PyRx?tab=readme-ov-file#installation and have look at the project 2, Download and install 3.12.10 x64 from https://www.python.org/downloads/windows/ (all users is NOT checked, and PATH is checked) 3, Open up PowerShell and type “pip install cad-pyrx” without the quotes. 4, in BricsCAD, type “appload”, navigate to: “AppData\Programs\Python\Python312\Lib\site-packages\pyrx\RxLoaderV25.0.brx” 5, Make sure it’s loaded, type “pyload” at the bricscad prompt 6, if the load dialog box shows, then were successful so far 7, close bricscad 8, back in powershell type “pip install openpyxl” , this will install the excel library. 9, copy paste the sample code above into a file into a text file, “myfirstmodule.py” 10, using a text editor, edit the paths in the sample, maybe rename the “doit” command 11, open BricsCAD, type in “pyload”, load your module, run your new command If you get this far, you might want to grab a python editor like VsCode and install the python plugins

Hi Something like This? (defun c:GLVScopi (/ cj cj1 n e mx my) (if (setq cj (ssget '((0 . "*TEXT")))) (progn (setq cj1 (ssadd)) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (setq tx (cdr (assoc 1 (setq l (entget e)))) mx (if mx (min (cadr (assoc 10 l)) mx) (cadr (assoc 10 l))) my (if my (min (caddr (assoc 10 l)) my) (caddr (assoc 10 l))) ) (entmake (subst (cons 1 (strcat (chr (+ (ascii (substr tx 1 1)) 1)) (substr tx 2))) (assoc 1 l) l)) (ssadd (entlast) cj1) ) (command "_move" cj1 "" (list mx my)) ) ) (princ) )

As StevenP says, to request any parameter from the keyboard, consider the following: -If it's an integer: 'getint' -If it's a decimal number: 'getreal' -If it's a text string: 'getstring' The advantage of using 'getint' or 'getreal' (as appropriate) is that the function itself will prevent the user from entering data that doesn't match the expected type. However, if you use 'getstring', any data entered will be considered a text string and will need to be converted. In this case, if the user had mistakenly entered a string beginning with a non-numeric character (for example, "y734"), converting it with 'atoi' or 'atof' would return 0. Therefore, it's advisable to use the 'get...' functions appropriately.

This function returns the screen resolution. To get the cursor size in real time and drawing units, simply run the following: (* (/ (AnchoResol) 100.0) (getvar "CURSORSIZE") (/ (GETVAR "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) )

@CADSURAY sorry to burst your bubble but Protected lisp is easy to convert back to plain text. It was introduced say at least 30 years ago. That why these days we have VLX and DES.

Hey @aridzv, Try this: ;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-first-layout-multiple-times-and-number-incrementally/td-p/7030955;;; (defun c:genlayouts-2 (/ trap1 olderr baselay tablist layname cnt entrec objrec a b nn adoc curpos curtab i n) (defun trap1 ( msg ) (setq *error* olderr); restore *error* symbol (princ) ) (setq olderr *error*); assign current function defintion held by the *error* symbol to a local variable - olderr (setq *error* trap1); pointing the *error* symbol to new function definition - trap1 (setq baselay (getvar 'ctab));;store base layout (setvar "tilemode" 1);;move to mode space (if (setq ssrect (ssget '((0 . "LWPOLYLINE") (70 . 1) (90 . 4))));;;;;;;;;;main if (progn (setq n (sslength ssrect)) (setvar 'ctab baselay);;back to base layout (and (= 0 (getvar 'tilemode)) (setq i (getint "\nEnter begining integer for suffix: ")) (setq curtab (getvar 'ctab)) ;(setq n (getint "\nHow many copies of this tab: ")) (repeat n (if (not(member (strcat curtab "." (itoa (+ (1- n) i))) (layoutlist))) (progn (command "._layout" "_copy" "" (strcat curtab "." (itoa (+ (1- n) i))));;create new layout tab (setq tablist (cons (strcat curtab "." (itoa (+ (1- n) i))) tablist)) (setvar 'ctab (strcat curtab "." (itoa (+ (1- n) i))));move to new layout tab );progn );if (setq i (1- i)) );repeat );and );end progn main );;;;;;;;;;end main if (setvar "tilemode" 0) (TabSort) (setq nn (sslength ssrect)) (setq cnt (- (sslength ssrect) 1)) (repeat nn (setq layname (nth (1- nn) tablist)) (setvar 'ctab layname) ;;; (setvar "tilemode" 0) (command "MSPACE") ;;;;;;;;;;;;;;by Steven P https://www.cadtutor.net/forum/topic/76216-create-layout-from-a-grid-in-model-space/;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;create viewport from rectangle in current layout;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (setq entrec (ssname ssrect cnt));get rectangle ename (progn (setq objrec (vlax-ename->vla-object entrec));Transforms entrec to a VLA-object (vlax-invoke-method objrec 'GetBoundingBox 'a 'b); get max and min points of the rectangle as safe array (setq a (vlax-safearray->list a));convert a from safe array to list (setq b (vlax-safearray->list b));convert b from safe array to list (vl-cmdf "_.zoom" a b) (command "PSPACE") );progn (alert "no ent") );if ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq cnt (1- cnt)) (setq nn (1- nn)) ;;; (setvar "tilemode" 0) );repeat ;(princ tablist) ;;;(TabSort) (setq *error* olderr); restore *error* symbol (princ) );defun ;;;;https://www.cadtutor.net/forum/topic/10087-re-ordering-layout-tabs/;;;;; ;; --------------------------------------------------------------------------- ;; Function: tabsort ;; Purpose : sort Tabs by the prefix then the first numbers found ;; AUTHOR Charles Alan Butler @ TheSwamp.org ;; --------------------------------------------------------------------------- ;; Last Update 03/01/2006 CAB (defun TabSort (/ cnt doc lay) (vl-load-com) ;; --------------------------------------------------------------------------- ;; Function: Num_sort ;; Purpose : sort list of strings by the prefix then the first numbers found ;; AUTHOR Charles Alan Butler @ TheSwamp.org ;; Params : tablst: list of strings to sort ;; Returns : sorted list ;; --------------------------------------------------------------------------- (defun Num_Sort (tablst / tab ptr len loop tmp tmp2 sub lst) (defun vl-sort-it (lst func) (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst func)) ) (defun sort2 (tmp2 sub) (setq tmp2 (append (vl-sort-it sub '(lambda (e1 e2) (< (cadr e1) (cadr e2)))) tmp2 ) ) ) ;; convert to a list (string) -> (prefix num string) (foreach tab tablst (setq ptr 1 len (strlen tab) loop t ) (while loop (cond ((wcmatch "0123456789" (strcat "*" (substr tab ptr 1) "*")) (setq tmp (cons (list (substr tab 1 (1- ptr)) (atof (substr tab ptr)) tab ) tmp ) loop nil ) ) ((> (setq ptr (1+ ptr)) len) ;; no number in string (setq tmp (cons (list tab nil tab) tmp) loop nil ) ) ) ; end cond stmt ) ) ;; sort on the prefix (setq tmp (vl-sort-it tmp '(lambda (e1 e2) (< (car e1) (car e2))))) ;; Do a number sort on each group of matching prefex (setq idx (length tmp)) (while (> (setq idx (1- idx)) -1) (cond ((not sub) (setq sub (List (nth idx tmp)) str (car (nth idx tmp)) ) ) ((= (car (nth idx tmp)) str) ; still in the group (setq sub (cons (nth idx tmp) sub)) ) ) ; end cond stmt (if (= idx 0) ; end of list (progn (setq tmp2 (sort2 tmp2 sub)) (if (/= (car (nth idx tmp)) str) (setq tmp2 (append (list (nth idx tmp)) tmp2)) ) (setq str (car (nth idx tmp))) ) ) (if (/= (car (nth idx tmp)) str) ;; next group, so sort previous group (setq tmp2 (sort2 tmp2 sub) sub (list (nth idx tmp)) str (car (nth idx tmp)) ) ) ) ; end while (setq lst (mapcar 'caddr tmp2)) (princ) lst ) ; end defun ;;========================================================================== (setq cnt 1 doc (vla-get-activedocument (vlax-get-acad-object)) ) (foreach lay (num_sort (vl-remove "Model" (layoutlist))) (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt) (setq cnt (1+ cnt)) ) (princ) ) ; end defun (prompt "\nTabSort loaded, enter TabSort to run.") (princ) See the attached video. I left only A-0 layout. LAYOUT.mp4

Kind of defeats the object of the forum though of sharing knowledge so that those who need or want to learn from others can do so from those who want to share their code freely. A locked LISP file is great for a finished project but... useless otherwise really. Often the threads are asking for assistance with a snippet of a larger project, and to lock it away doesn't help. Basic manners helps, credit the code where credit is due, a link to the original codes so that others can read and learn.

Dear @Saxlle, @Steven P thank You for Your answers and discusison. I think that code send by @Steven P Is what I was looking for. I've tried to implement 'solutions' from Excel into my script but there are much simpler and effective techniques I was not aware of. Thank You again for the answers Marcin

Have you thought about using a script, it can open a new dwg and will automatically then be in that dwg. Script code. (command "New" "Yourtemplatename") (alert "now in other dwg do your lisp code here") version 2 (command "New" "Yourtemplatename") (load "your lisp program")

If you use Vlide it will do bracket checking, I use Notepad++ it has a bracket check function also. just a comment I have 3 make layouts from rectangle, pick a point, walk along pline, horizontal aligned, the make layouts part supports rotated rectangle. Happy to discuss more.

Use entmakex. ; A 1000x500 rectangle with horizontal sides with a global width of 40, vertical sides with a global width of 0. (defun c:RectWidth-hor40 (/ pt1 pt2 hWidth vWidth p1 p2 p3 p4 pl) (setq width 1000 ; Rectangle width height 500 ; Rectangle height hWidth 40 ; Global width of horizontal sides vWidth 0) ; Global width of vertical sides (setq pt1 (getpoint "\nSpecify the insertion point: ")) (setq p1 pt1 p2 (list (+ (car pt1) width) (cadr pt1)) p3 (list (+ (car pt1) width) (+ (cadr pt1) height)) p4 (list (car pt1) (+ (cadr pt1) height))) (setq pl (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 p1) (cons 40 hWidth) (cons 41 hWidth) (cons 10 p2) (cons 40 vWidth) (cons 41 vWidth) (cons 10 p3) (cons 40 hWidth) (cons 41 hWidth) (cons 10 p4) (cons 40 vWidth) (cons 41 vWidth) ) ) ) (princ) )

solved it, instead of pt I put '(0.0 0.0 0.0) and it works.(pt and r are acquired at start of lisp) THANX again for ur help and guidance, and @Tharwat for his lisp that gave me idea

I really miss that guy. ;/ He was such a witty kind person and one of the most talented lisp programmers I knew.

I hate spending time correcting AI-generated code, but the first thing that sticks out is that the following: (setq attArray (vla-getattributes vlaBlock)) Will return a safearray variant, which cannot be iterated directly using foreach. Instead, you can use: (setq attArray (vlax-invoke vlaBlock 'getattributes)) Which will return the data using native data types, i.e. a list. You can find more examples here.

This function was originally written by the late great Michael Puckett - https://www.theswamp.org/index.php?topic=38072.0

PS: Someday you'll win one of those public tenders, and when that happens, I hope you'll come over here and have a coffee with one of us Good luck!

Hi @PGia I think this should meet your needs. I could say I wrote it from scratch just for you, but really, I also did it for myself. I had a good time revisiting old concepts. As I said, this is much easier to do with Map or Civil3D, creating topologies and manipulating them with the 'mnt*' functions. But writing this code has helped me prove that these tools can also be done in Lisp, with reasonably good results. The expressions are in my language. You'll have to translate them into yours. ;******************* G L A V C V S ******************* ;********************* F E C I T ********************* (defun c:spf>PGia (/ conj cj cjP ent n lstent en ex d pt i l lC lCs cE ltS ltV ltds s lSV actEtqs selR) (defun lSV (l / p r) (setq ltS (cons (list (setq s (vlax-ename->vla-object (car l))) (cadr l)) ltS) lCs (cons (list s (last l)) lCs)) (foreach x (reverse (cdr l)) (if p (if (not (member x ltds));ltds es la lista de los ya tocados (if (setq r (assoc p ltV)) (setq ltV (subst (list (car r) (+ (cadr r) (vla-get-area x))) r ltV) ltds (cons x ltds));ltV es una lista en que se asocia el identificador de las lineas contenedoras con la suma de la áreas de las contenidas (setq ltV (cons (list p (vla-get-area x)) ltV) ltds (cons x ltds)) ) ) ) (setq p x) ) ) (defun actEtqs (/ a b c e p pc l et tx) (foreach v (reverse ltS) (setq e (car v) p (cadr v) pc (last v)) (if (= (vla-get-layer e) "US") (setq l (cadr (assoc e lCs)) tx (vl-some '(lambda (x) (if (equal (cadr x) l) (vla-get-textstring (car x)))) ltS)) (setq tx nil) ) (if (/= (vla-get-layer e) "GEN") (vla-put-color p 6)) (vla-put-textstring e (strcat (if tx (strcat tx "-") "") (vla-get-textstring e) ":" (rtos (- (vla-get-area p) (if (setq a (assoc p ltV)) (cadr a) 0)) 2 2)) ) ) ) (defun selR (p / r s l lt en ex cj n o r4 f) (defun r2+ (p l r / i b) (vl-some '(lambda(g) (= 2 (setq r (if (foreach a (cons (last l) l) (if b (if (inters p (polar p g d) b (setq b a)) (setq i (not i))) (setq b a)) i) (+ r 1) r)))) '(0 1.5708 3.141592 4.71239) ) ) (if (setq cj (ssget "_F" (list p (list (car p) (+ (cadr p) (getvar "viewsize")))) (list '(0 . "LWP*") (cons 8 "PRMTR") '(-4 . "&=") '(70 . 1)) ) ) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (if (r2+ p (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e))) 0) (progn (setq l (cons (vlax-ename->vla-object e) l)) (if (ssmemb e cjP) (ssdel e cjP))) ) ) ) (if l (vl-sort l '(lambda (a b) (< (vla-get-Area a) (vla-get-Area b))))) ) (setq en (getvar "extmin") ex (getvar "extmax") n -1 d (max (- (car ex) (car en)) (- (cadr ex) (cadr en))) ) (vla-zoomExtents (vlax-get-acad-object)) (setq cjP (ssget "x" (list '(0 . "LWP*") (cons 8 "PRMTR") '(-4 . "&=") '(70 . 1)))) (if (setq conj (ssget "_X" '((0 . "TEXT") (8 . "GEN,US")))) (while (setq ent (ssname conj (setq n (1+ n)))) (setq lstent (entget ent) pt (cdr (assoc 10 lstent))) (if (setq l (selR pt)) (lSV (cons ent l)) (princ (strcat "\n*** Etiqueta " (cdr (assoc 1 lstent)) " huerfana"))) ) ) (if (> (sslength cjP) 0) (alert "ATENCION: Hay polilíneas sin asignar")) (alert (strcat "Numero de perímetros procesados: " (itoa (length ltS)))) (actEtqs) (princ) )

There are a few threads around here on this topic. Basically, you can't 100%, as it can still be traced and or duplicated from the dimensions if there are any, etc., best way is to make it as hard as possible. A well worded contract on not reusing your information will go along way to prevent conversion/reuse, just get legal services on specifics. Preventing our PDFs From Being Imported into Acad as Autocad Entities? - AutoCAD Drawing Management & Output - AutoCAD Forums PDF/ JPG file conversion threat. - AutoCAD 2D Drafting, Object Properties & Interface - AutoCAD Forums

Ditto. I never knew it was possible to genuinely grieve the loss of someone you'd never met in person, but when I see an old post of his I'm reminded of just how much he contributed to the community and how much I miss our conversations.

Just a comment when you get the attributes as a list you can edit any attribute by its position in the list so don't need a Tag name search. (nth 9 atts) is "TYPE" the 1st item in a list is (nth 0 .Sometimes its easier to do it this way.

Of course it happens in the lisp, that's the idea. see at the start of the code (setq osnp (getvar "OSMODE")) (setvar "OSMODE" 0) and at the end of the code restore the OSNAP mode: (command "._PSPACE") (SETVAR "OSMODE" osnp) (princ) Try selecting the block with the cursor trying to snap at every entity around...

try the last code and finish the command with ENTER, not escape or right click. only ENTER.

you select an empty space

'Hatch' isn't defined in the block definition, but the hatch references the block it is contained in (I think) - the opposite to what you'd expect.

A couple of ways to do this: Create the block without the hatch, bedit it and in the block editor add the hatch. Use entmakex to create the block so that you have the block entity name to go into. This is slow though, opens up the block editor on the screen so also gives screen changes. This uses pure entmake. A more efficient way is to use vla-addhatch - it is all online with the key to this method being you need to add (vla-evaluate MyHatch) at the end of the hatch definition (where MyHatch is your hatch definition). It doesn't use entmake as such but things like the outlines, hole, hatch patterns etc. can all be done with entmake. This method doesn't open the block editor and is a lot quicker. -EDIT- Link wasn't a goo example

use the last code I shared - it deals with the error issue. if it dosn't work - stroke out all the error refrences in the code. I didn't had any issues but if you think the error hadling give you problems than take it out.... edit: in the error trap change (command "._PSPACE") to (SETVAR "TILEMODE" 0) it is not a command so mybe this will solve the issue.

A slightly more complete version. Maybe it will be useful to someone someday. (defun c:GLAVCVSfibo (/ n cierraOtro p1 p2 p3 p4 i osmant cja f1 f2) (defun cierraOtro (f1 f2 / d ang) (setq d (+ f1 f2) ang (angle p2 p3) ) (command "_pline" (setq p1 p3) (setq p2 (polar p3 ang d)) (setq p3 (polar p2 (- ang i) d)) (setq p4 (polar p3 (- ang i i) d)) (polar p4 (- ang PI i) d) "") (command "_arc" "c" p4 p3 p1) (ssadd (entlast) cja) ) (setq n (getint "\nFibonaciCAD: Specifies number of sequences: ")) (setq f1 0 f2 1 i (/ PI 2) osmant (getvar "osmode")) (setvar "osmode" 0) (command "_pline" (setq p1 '(0 0)) (setq p2 '(-1 0)) (setq p3 '(-1 1)) (setq p4 '(0 1)) '(0 0) "") (command "_arc" "c" p4 p3 p1 "") (setq cja (ssadd)) (ssadd (entlast) cja) (repeat (- n 1) (cierraOtro f1 f2) (setq f f2 f2 (+ f1 f2) f1 f) ) (command "_pedit" "_m" cja "" "" "_j" 0 "") (setvar "osmode" osmant) (princ) )

@Nikon You should keep one thing in mind: the actual number of iterations will be 1 more than you specify. I forgot to consider the first one, which is done before the loop. Therefore, you should change 'repeat n' to 'repeat (- n 1)'

Oh wait... Here's a script I wrote 15 years ago ; ; Fibonacci spiral ; (defun fib () (princ "\nThis command draws a Fibonacci spiral. On my computer the max number of lines is a bit less than 50") (setq number_of_lines (getint "\nDraw a Fibonacci spiral.\nHow many sides: ")) (setq insertPoint (list 0 0)) (setq previousInsertPoint (list 0 0)) (setq twoPointsBack (list 0 0)) (setq key 1) (repeat number_of_lines (progn ; length of the line (setq newLength (fibonacci key)) ; the newest line is drawn +90° of the previous line (setq remainder (rem key 4) ) (setq angle (* remainder (/ PI 2.0)) ) ; draw the line. Retrieve the secondary point (that point will be the insert point of the next line) (setq secondaryPoint (drawNewLine insertPoint angle newLength )) ; ARC (setq radius (distance previousInsertPoint insertPoint)) (setq center twoPointsBack) (setq start_angle (* (- remainder 1) (/ PI 2.0)) ) (setq end_angle angle) (entmake (entmake_arc center radius start_angle end_angle) ; listed properties of an arc. ready to entmake ) ;; prepare variables for new iteration (setq oldLength newLength) (setq twoPointsBack previousInsertPoint) (setq previousInsertPoint insertPoint) (setq insertPoint secondaryPoint) (setq key (+ 1 key) ) ) ) (princ) ) (defun drawNewLine (insertPoint angle distance / secondaryPoint) (setq secondaryPoint (polar insertPoint angle distance)) (entmake (mapcar 'cons (list 0 100 8 62 100 10 11) (list "LINE" "AcDbEntity" "0" 3 "AcDbLine" insertPoint secondaryPoint) ) ) secondaryPoint ) (defun fibonacci (index / new_value) (setq new_value nil) ; New value. Each value (except the first two) is the sum of two previous values. results in: 1 1 2 3 5 8 13 21 ... (setq val_a 1) ; 1 value back (setq val_b 1) ; 2 values back (if (= index 0) (progn ) ) (if (= index 1) (progn (setq new_value 1) ) ) (if (= index 2) (progn (setq new_value 1) ) ) (if (> index 2) (progn (setq i 0) (repeat (- index 2) (progn (setq new_value (+ val_a val_b)) ; preapre for new iteration (setq val_a val_b) (setq val_b new_value) ) ) ) ) new_value ) (defun entmake_arc (Center Radius start_angle end_angle / opts) (setq opts (mapcar 'cons (list 0 100 100 10 40 210 100 50 51) (list "ARC" "AcDbEntity" "AcDbCircle" Center Radius '(0 0 1) "AcDbArc" start_angle end_angle ) ) ) ;(std-%entmake-template elist opts '(10 40 50 51)) opts ) (defun c:fib () (fib) )

You should change "pol" to "_pline"

Maybe something like this? (defun c:GLAVCVSfibo (/ n cierraOtro p1 p2 p3 p4) (defun cierraOtro (f1 f2) (setq d (+ f1 f2) ang (angle p2 p3) ) (command "pol" p3 (setq p2 (polar p3 ang d)) (setq p3 (polar p2 (- ang i) d)) (setq p4 (polar p3 (- ang i i) d)) (polar p4 (- ang PI i) d) "") ) (setq n (getint "\nFibonaciCAD: Specifies number of sequences: ")) (setq f1 0 f2 1 i (/ PI 2)) (command "pol" '(0 0) (setq p2 '(-1 0)) (setq p3 '(-1 1)) '(0 1) '(0 0) "") (repeat n (setq f f2 f2 (+ f1 f2) f1 f) (cierraOtro f1 f2) ) (princ) )

Look for my attachments posted in this topic... (You have to be logged to download attached files...) Here is link : https://www.theswamp.org/index.php?topic=12813.255

EDIT: oh wait ... I got a mistake somewhere. It makes a spiral, but not the Fibonacci spiral exactly. (vl-load-com) ;; https://www.cadtutor.net/forum/topic/75640-arc-start-and-end-point-help/ ;; Arc Endpoints - Lee Mac ;; Returns the endpoints of an Arc expressed in WCS (defun LM:ArcEndpoints ( ent / cen nrm rad ) (setq ent (entget ent) nrm (cdr (assoc 210 ent)) cen (cdr (assoc 010 ent)) rad (cdr (assoc 040 ent)) ) (mapcar (function (lambda ( ang ) (trans (mapcar '+ cen (list (* rad (cos ang)) (* rad (sin ang)) 0.0)) nrm 0) ) ) (list (cdr (assoc 50 ent)) (cdr (assoc 51 ent))) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun drawArc (cen rad sAng eAng) (entmakex (list (cons 0 "ARC") (cons 10 cen) (cons 40 rad) (cons 50 sAng) (cons 51 eAng))) ) (defun deg2rad (deg) (* pi (/ deg 180.0)) ) (defun c:Fibonacci ( / it ind arc fib fib_prev cen prev_cen rad sAng eAng endpts) (setq it (getint "\nHow many iterations (above 2 please): ")) ;; iteration 1 (setq ind 1) (setq fib_prev 1) (setq fib 1) (setq cen (list 0.0 0.0) rad 1.0 sAng 0 eAng (deg2rad 90) ) (setq arc (drawArc cen rad sAng eAng)) ;; iteration 2 (setq ind 2) (setq fib_prev 1) (setq fib 1) (setq cen (list 0.0 0.0) rad 1.0 sAng (deg2rad 90) eAng (deg2rad 180) ) (setq arc (drawArc cen rad sAng eAng)) ;; iteration 3 and further (while (<= ind it) (setq ind (+ ind 1)) (setq fib_prev fib) (setq fib (+ fib_prev fib)) (setq endpts (LM:ArcEndpoints arc)) (setq sAng eAng ;; start angle is the previous end angle eAng (+ eAng (deg2rad 90)) ;; end angle: add 90° cen (polar (nth 1 endpts) (+ eAng (deg2rad 90)) fib) ;; new center: endpoint of the previous arc; polar => 90° extra of endArc, dist of fibonacci length rad fib ) (setq arc (drawArc cen rad sAng eAng)) ) (princ) )

You're welcome . This part of code can be just an option/alternative to get a attribute position (it's not neccessery). (setq pt_attdef_one (polar pt 0.785 10) ;; 0.785 is the angle of 45 degree, 10 is the length (you can change the angle and length) pt_attdef_second (polar pt 5.497 10) ;; 5.497 is the angle of 315 degree, 10 is the length (you can change the angle and length) ) I think if both values nonzero 72 2 and 74 3, or 72 for e.g 1 and 74 0, or 72 for e.g 0 and 74 1, the text insertion point values are ignored. Really don't know... P.S. Bitno je da radi sada

If values for 72 and 74 dxf codes supplied, you will get this (link): If group 72 and/or 74 values are nonzero, then the text insertion point values are ignored and new values are calculated by AutoCAD based on the text alignment point and the length of the text string itself (after applying the text style). If you want to avoid this, than you can for the second attribut making according to insertation point (pt) do this "(cons 10 (cons 10 (list (car pt) (- (cadr pt) 0.3) (caddr pt)))" (where 0.3 is the text height), and you will get something like this and need to put (cons 74 0) in all attribut definition: If (cons 74 0) are non-zero value, I get this: Also, you can change (cons 70 0) to be visible, otherwise the values are not appears to be visible in drawing.

@GLAVCVS, just test it your code and it also works great . I started something new to writte and didn't have time to finish it, when everything is going to be done and tested, I will also post it. Just a little notice @GLAVCVS (picture 1 and 2): - picture 1: the total area need to be substracted from areas 1, 2, 3 and 4. - picture 2: the total2 area need to be substracted from areas 1 and 2, and the total1 area need to be substracted from areas 1, 2 and total2 (at this part I stopped writting the code). Agree with this part. From last post when I said "So, maybe to find a good organization in file (for e.g. layers names, closed polygons of polyline, TEXT /MTEXT formatting, entities in right layers, etc.)", I meant on that.

Finally, the code assumes that the perimeters in the drawing will be closed LWpolylines, the labels will be text, and the layers will be the same as in the example you attached. If any of these conditions are not met, it won't work.

How does it work? Although it may seem like there's little code, it does a lot more than meets the eye: - associates each polyline with the text inside it - calculates the area of each perimeter and associates it with the text inside, taking into account the secondary perimeters - changes the color of the secondary perimeters and adds a reference to the main perimeter to their labels - checks whether all perimeters and labels have been found and leaves a warning if this hasn't happened There are a few more details I've left unresolved so as not to go on about this any longer (because it probably doesn't matter) but that you should keep in mind: - If there is more than one label inside a perimeter, it will associate the same information with both and won't give you any warning - If there is an unlabeled perimeter, it will leave a warning but won't tell you where it is.

After that, all that's left is to identify which of the objects created by 'boundary' matches the rectangle. '(ssadd (entlast) dm)' is useless because it might select the wrong polyline. I would use, for example: (setq f (ssget "_X" (list '(0 . "LWP*") '(-4 . "=,=,*") (list 10 (car p1) (cadr p1) 0.0))))

I think you misunderstood me. You should write: (setq m (polar p1 (angle p1 p2) (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")))))

You can calculate this using: (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")))

Another thing to keep in mind is that calculating a point just 1 drawing unit from the bottom corner of the rectangle may cause "boundary" to not work correctly. You may want to calculate that point by applying the drawing distance equivalent to one pixel.

Here is a similar code: Block name in text. EFF_NAME.lsp