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.

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

Lee Mac has this on his website: https://lee-mac.com/boundingbox.html and you can modify the test function to be a selection set and loop through that, not sure if that is any use?

Maybe you can create insted of Arc a Polyline Arc, like from this Lee Mac Bulge Conversion Functions. It will look like this: Try with that and see if it helpful.

Right. Autocad is still a technical drawing program, mimicing pen and paper. The user can tilt the paper (UCS), and then draws on that plane. So a circle or an arc means that you set the needle on thet plane, then you draw on that plane. You can't elevate the start or endpoint. You can elevate the whole arc, you can tilt the plane on which the arc is drawn... If you could elevate just 1 start or endpoint then it's no longer an arc. That's the general idea, it's not absolutely true, since there are things like 3D polylines

I seem to remember that you can't change the elevation of the start/end points, which is why they're greyed out in the properties. You can change the center point's elevation, which makes things easier.

AFAIK, you cannot. How to batch remove the "-Model" suffix from plotted files name in AutoCAD I use a program called Bulk Rename Utility to rename files or you could try the suggested method in the link above. This LISP solution might work... How do I plot to PDF with only the filename (without the layout name) - Autodesk Community Also mentioned that PDFCreator can do this.

An Arc has - a Center point: code 10 - a radius: code 40 (which is usually a scale code) - a start angle: code 50 - a end angle: code 51 Which is the most logical way of coding an arc, I would say. The same codes apply for the circle, if the circle were to be full. Except of course that circle doesn't have a start and endpoint --- For a block INSERT code 10 is the insertpoint, ... but yes, often code 10 in the start point, as you say

@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.

Nice try!

Am I too late for this party? Anyway, here's my try: (defun c:fibonacci() (setq pi2 (/ PI 2.0) as0 (cons 0 "line") col '(62 . 3)) (defun fib(ins dir dim) (entmake (list as0 (cons 10 ins) (cons 11 (setq p2 (polar ins (- dir pi2) dim))))) (entmake (list as0 (cons 10 p2) (cons 11 (setq p3 (polar p2 dir dim))))) (entmake (list as0 (cons 10 p3) (cons 11 (setq p4 (polar p3 (+ dir pi2) dim))))) (entmake (list (cons 0 "ARC") (cons 10 p4) (cons 40 dim) (cons 50 (- dir pi)) (cons 51 (- dir pi2)) col)) (setq dir (+ dir pi2)) ) (setq a 1 b 1 dir 0 ins '(0 0)) (repeat 19 (fib ins (setq dir (+ pi2 dir)) a) (setq c (+ a b) a b b c ins p3) ) )

You're welcome. Glad it works

@Saxlle thanks!! yes, I didn't move to model space before the zoom.... here is the final lisp I'm going to use with 2 additions: 1. make sure the lisp start in a layout tab. 2. create new layout tab if that tab name already exist. ;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-first-layout-multiple-times-and-number-incrementally/td-p/7030955;;; (defun c:vpfrectngl-multi (/ trap1 olderr baselay tablist layname cnt entrec objrec a b nn adoc curpos curtab lytname lytcnt i n) (defun trap1 (errmsg) (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 (if (= (getvar "tilemode") 0);if1 in layout (progn;progn-1 (setq baselay (getvar 'ctab));;store base layout (setvar "tilemode" 1);;move to mode space (if (setq ssrect (ssget '((0 . "LWPOLYLINE") (70 . 1) (90 . 4))));;;;;;;;;;if2 (progn ;progn-2 (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)) (repeat n (setq lytcnt 1) (setq lytname (strcat curtab "." (itoa (+ (1- n) i)))) (while (member lytname (layoutlist));while-1 if layout tab name exist add 1 to suffix until it is a new name (setq lytname (strcat curtab "." (itoa (+ (1- n) (+ i lytcnt))))) (setq lytcnt (1+ lytcnt)) );while-1 (command "._layout" "_copy" "" lytname) ;(strcat curtab "." (itoa (+ (1- n) i))));;create new layout tab (setq tablist (cons lytname tablist)) ;(strcat curtab "." (itoa (+ (1- n) i))) (setvar 'ctab (strcat curtab "." (itoa (+ (1- n) i)))) ;(strcat curtab "." (itoa (+ (1- n) i))));move to new layout tab (setq i (1- i)) );repeat );and );end progn-2 );;;;;;;;;;end if-2 (setq nn (sslength ssrect)) (setq cnt (- (sslength ssrect) 1)) (repeat nn (setq layname (nth cnt tablist)) (setvar 'ctab layname) ;;;;;;;;;;;;;;;;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 (command "mspace") (vl-cmdf "_.zoom" a b) (command "pspace") );progn (alert "no ent") );if ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq cnt (1- cnt)) (setvar "tilemode" 0) );repeat );end progn-1 (alert "NOT IN PAPER SPACE") );end if1 ;(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)

QNEW opens the Template referenced in QNEW so SysVars would be set and known. I see no reason to go about this in the manner desired by the OP and the OP seems determined to do things the hard way.

@Steven P nice... somewhat old but very useful... I added a few small things that make it a little more convenient for me, and maybe for others too... Great lisp!! ;;https://forums.autodesk.com/t5/autocad-forum/having-trouble-with-the-lisp-that-zooms-a-rectangle-that-fits-in/td-p/9378532 ;; draw rectangle aroud the viewport,copy the rectangle to model space where you need to print. ;; for 1:1 (1:1000m) don't scale. for 1:1250 scale 1.25 etc' (defun c:zvprect1 ( / *error* trap1 olderr a b e o) ;; I renamed this to fit my brain: 'z' - zoom, 'vp' - viewport, 'rect' - rectangle (defun trap1 ( msg ) (command "._PSPACE") (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 (command "._MSPACE") (if (setq e (car (entsel "\nSelect Rectangle : "))) (progn (setq o (vlax-ename->vla-object e)) (vlax-invoke-method o 'GetBoundingBox 'a 'b) (setq a (vlax-safearray->list a)) (setq b (vlax-safearray->list b)) (vl-cmdf "_.zoom" a b) );progn );if (command "._PSPACE") (setq *error* olderr); restore *error* symbol (princ) )

If achieving zoom extensions is so important and you can't do it any other way, the quickest solution might be to write a DXF and define the initial view in it. But I suppose you'd have to find a simpler solution.

I didn't look into what your code is doing, but if you use QNEW, focus goes to the new drawing.

This is a way that I have found to do it: 1) Start the LISP that will open the new drawing. 2) In this LISP, set a variable to the Blackboard namespace via (vl-bb-set), alternatively, you could set a value in the registry or a temporary text file. 3) Add a portion to the startup code in "acaddoc.lsp" to check the value of the variable using (vl-bb-ref), and if set, perform the (vla-ZoomExtents). 4) clear the variable previously set with (vl-bb-set) again to set the value to nil.

Maybe Tharwat was referring to this code... Please help me create a lisp to Change color of dimension - AutoLISP, Visual LISP & DCL - AutoCAD Forums

Yes, you're right, agree. The only problem can be if you have the same "index", like: (setq MyList (list '(10 26509533.29 26509533.29 100.0) '(11 26509533.29 26509533.29 100.0) '(20 9985631.7 9985631.7 100.0) '(21 9985631.7 9985631.7 100.0) ;; same index value "21" '(30 6266660.57 6266660.57 20.0) '(21 9985631.7 9985631.7 100.0) ;; same index value "21" ) ; end list ) I haven't gone into depth on every possible problem, but it will work as expected.

@aridzv I am very grateful to you! That's what I need! Good luck!

see below: (defun c:ChDimTxtCol1 (/ i sel ent obj) (vl-load-com) (setq i 0) ;(setq DimTextColor 1) (if (setq sel (ssget '((0 . "*DIMENSION")))) (progn (repeat (sslength sel) (setq ent (ssname sel i)) (setq obj (vlax-ename->vla-object ent)) (if (/= (vlax-get obj 'textoverride) "") (vlax-put-property obj 'TextColor 1) ;(vlax-put-property obj 'TextColor DimTextColor) );if (setq i (+ i 1)) );end repeat );end progn (alert "No Dimensions selected") );end if sel (princ) );defun *EDIT: I removed the "DimTextColor" varaible because it is redandet and set the textcolor directly to 1 this way: (vlax-put-property obj 'TextColor 1)

The blocks appear to be identical apart from the fact that each block is given an individual name. They appear to have the same attributes but in different order. So my question is why do you not just have one block ? But with all the details different each time you insert that block. Are you using some form of software to make the blocks ? The blocks just look to random. Are you copying and pasting from other dwg's ? I think if you give us some background on how your getting to this point we may be able to fix it for the next dwg.

You can check has text been overidden. ; TextOverride = "<> ABC" ABC added ; TextOverride = "" this has not been cahnged (vlax-get obj 'textoveride)

add xdata to create a dimstyle override , in python it would be xd = [(1001, "ACAD"), (1000, "DSTYLE"), (1002, "{"), (1070, 178), (1070, 1), (1002, "}")] # add dim override @command def doit2(): ps, id, _ = Ed.Editor.entSel("\nSelect:", Db.Dimension.desc()) if ps != Ed.PromptStatus.eOk: return dim = Db.Dimension(id, Db.OpenMode.kForWrite) # todo check if there's aready a dimstyle override # 178 = dimclrt # 1 is red xd = [(1001, "ACAD"), (1000, "DSTYLE"), (1002, "{"), (1070, 178), (1070, 1), (1002, "}")] dim.setXData(xd)

(defun C:ChDimTxtCol1 (/ int sel ent obj DimTextColor) (vl-load-com) (setq DimTextColor 1) (and (setq int -1 sel (ssget '((0 . "*DIMENSION"))) ) (while (setq int (1+ int) ent (ssname sel int)) (setq obj (vlax-ename->vla-object ent)) (if (/= (vla-get-textHeight obj) (getvar'DIMTXT)) (vla-put-TextColor obj DimTextColor)) ) ) (princ) )

I have this for a metric system, I don't know if it would be suitable for a foot system...! But it can be a start for you. (defun C:SLOPE ( / blp pt_o pt_f frac_prec sv_osmd e_last dxf_o slope slope_h slope_v nx sv_ortho pt_start pt_x t2_slope t1_slope pt_mid pt_text pt_int ed_1) (setvar "cmdecho" 0) (setq blp (getvar "blipmode")) (setvar "blipmode" 0) (initget 9) (setq pt_o (getpoint "\nSpecify the starting point: ")) (cond (pt_o (initget 41) (setq pt_f (getpoint pt_o "\nChoosing the end point: ")) (cond (pt_f (command "_.undo" "_group") (cond ((and (not (eq (getvar "USERI1") 1)) (not (eq (getvar "USERI1") 10)) (not (eq (getvar "USERI1") 100))) (initget "Unit Dozen Hundred") (setq frac_prec (getkword "\nFraction accuracy [Unit/Dozen/Hundred]<Dozen>: ")) (if (not frac_prec) (setq frac_prec "Dozen")) (cond ((eq frac_prec "Unit") (setq slope_v 1)) ((eq frac_prec "Dozen") (setq slope_v 10)) ((eq frac_prec "Hundred") (setq slope_v 100)) ) (setvar "USERI1" slope_v) ) (T (setq slope_v (getvar "USERI1"))) ) (setq sv_osmd (getvar "osmode")) (setvar "osmode" 0) (command "_.ray" pt_o pt_f "") (setq e_last (entlast) dxf_o (trans (cdr (assoc 11 (entget e_last))) 0 1 T) ) (entdel e_last) (setq slope (abs (if (zerop (cadr dxf_o)) 0.0 (/ (car dxf_o) (cadr dxf_o)))) slope_h (fix (* slope_v slope)) nx (if (zerop slope_h) 0 (gcd slope_h slope_v)) sv_ortho (getvar "orthomode") ) (while (> nx 1) (setq slope_h (/ slope_h nx) slope_v (/ slope_v nx) nx (gcd slope_h slope_v)) ) (setvar "orthomode" 1) (setq pt_start (mapcar '/ (mapcar '+ pt_o pt_f) '(2.0 2.0 2.0)) pt_start (list (car pt_start) (cadr pt_start) 0.0)) (initget 9) (setq pt_x (getpoint pt_start "\nSpecify the size of the symbol: ") pt_x (list (car pt_x) (cadr pt_x))) (if (equal (car pt_x) (car pt_start) 1E-12) (setq t2_slope (rtos slope_h 2 0) t1_slope (rtos slope_v 2 0)) (setq t2_slope (rtos slope_v 2 0) t1_slope (rtos slope_h 2 0)) ) (repeat 2 (command "_.dimordinate" pt_start "_text" t1_slope pt_x) (setq pt_mid (mapcar '/ (mapcar '+ pt_start pt_x) '(2.0 2.0 2.0))) (if (equal (car pt_x) (car pt_start) 1E-12) (setq pt_int (polar pt_x 0.0 (distance pt_start pt_x))) (setq pt_int (polar pt_x (/ pi 2.0) (distance pt_start pt_x))) ) (setq pt_start (inters pt_o pt_f pt_x pt_int nil) t1_slope t2_slope ) (if (null pt_start) (setq pt_start pt_x)) (setq pt_text (polar pt_mid (angle pt_start pt_x) (getvar "dimtxt")) ) (command "_aidimtextmove" "_2" (entlast) "" pt_text) (if (not ed_1) (setq ed_1 (entlast))) ) (command "_.-group" "_create" "*" "" (entlast) ed_1 "") (setvar "orthomode" sv_ortho) (setvar "osmode" sv_osmd) (command "_.undo" "_end") ) ) ) ) (setvar "blipmode" blp) (setvar "cmdecho" 1) (prin1) )

Yes, LIPS is session based, that means you start a command in one drawing, it will run on one drawing and (generally) not run in another. A few ways round this. As BigAl says a script can cross drawings, open or create a new drawing, run commands in it. You could adjust the acad.lsp file, this runs on opening / creating a drawing, but your changes will run on every subsequent drawing Expanding acad.lsp file idea, you could add the below to acad.lsp file. Will work on EVERY new drawing. You could create the below as a stand alone LISP file, add it it the startup suit. Will work on EVERY new drawing You could create a temporary LISP file, search for it and if it exists run it (using acad.lsp or a file in the startup suit)... though of course you'd have to consider deleting after running. Will work on EVERY new drawing till temp file is deleted (can do that with LISP once it is loaded delete the file) Last one is a bit related, have a list of say, filename prefix and if the file name prefix is in this list do stuff... handy if say a clients drawings are all in the form "12345-dwg-001.dwg", search 123456 and if yes, do stuff. A step further on from the 'if new drawing do stuff' idea above All depends how your mind works and which you think is the best solution for you. (defun c:testthis ( / SavedDrawing ) (setq SavedDrawing (getvar "dwgtitled")) (if (= SavedDrawing 1) (progn (alert "Drawing has been saved, is not a new drawing") ) ; end progn (progn ; savedDrawing = 0 (alert "Drawing has not been saved, is a new drawing") ) ; end progn ) ; end if (princ) ) (c:testthis) ;; run on loading

Definitely: not possible. At least with my version of AutoCAD. Any line of code after the new drawing is created will not be executed in it. If zoomExtents is so important, you should consider an indirect solution (which I've never tried, but which may be possible): write a LISP in 'acad.lsp' so that it does a 'zoomExtents' when each drawing is opened. Perhaps someone can share their experience in this regard.

But remember: 'c' and 'r' must be 'nil' before running this 'ssget'

If, in addition, the selection must take into account the objects on those layers and that have their color set to "bylayer", then... (ssget "_X" (list '(0 . "LWP*") (cons 8 (while (setq c (tblnext "LAYER" (if c nil T))) (setq r (if (member (cdr (assoc 62 c)) '(1 5)) (if r (strcat r "," (cdr (assoc 2 c))) (cdr (assoc 2 c))) r)) ) ) '(-4 . "=,=,*") (list 10 (car p1) (cadr p1)) '(62 . 256) ) )

A brief explanation: 1) The line of code '(setq c nil)' is for if you have variable 'c' assigned because the 'while' clause of 'ssget' requires it to be initially 'nil'. 2) I've kept the filter to select only polylines that pass through point 'p1'. If you want to disable this filter, just disable the last two lines in the 'ssget' list. I hope I made myself clear.

I had a hard time understanding you. Let's see if I can get it this time: (setq c nil) (ssget "_X" (list '(0 . "LWP*") (cons 8 (while (setq c (tblnext "LAYER" (if c nil (not (setq r nil))))) (setq r (if (member (cdr (assoc 62 c)) '(1 5)) (if r (strcat r "," (cdr (assoc 2 c))) (cdr (assoc 2 c))) r)) ) ) '(-4 . "=,=,*") (list 10 (car p1) (cadr p1)) ) )

To include the layer colour, you'll need to iterate over the layer table first and construct an appropriate filter (or check the layer colour for each object within the selection and prune the selection). Here's an example - (defun c:test ( / def lay lst ) (setq lst '(1 5)) ;; Target colours (while (setq def (tblnext "layer" (null def))) (if (member (abs (cdr (assoc 62 def))) lst) (setq lay (cons (cons 8 (LM:escapewildcards (cdr (assoc 2 def)))) lay)) ) ) (sssetfirst nil (ssget "_X" (append '( (000 . "LINE") (-04 . "<OR") ) (mapcar '(lambda ( x ) (cons 62 x)) lst) (if lay (append '( (-04 . "<AND") (062 . 256) (-04 . "<OR") ) lay '( (-04 . "OR>") (-04 . "AND>") (-04 . "OR>") ) ) '( (-04 . "OR>") ) ) ) ) ) (princ) ) ;; Escape Wildcards - Lee Mac ;; Escapes wildcard special characters in a supplied string (defun LM:escapewildcards ( str ) (vl-list->string (apply 'append (mapcar '(lambda ( c ) (if (member c '(35 64 46 42 63 126 91 93 45 44)) (list 96 c) (list c) ) ) (vl-string->list str) ) ) ) ) (princ)

You didn't mention that you want a polylines. Just susbtitue (0 . "LINE") with (0 . "LWP*"). (setq ln (ssget '((0 . "LWP*") (-4 . "<OR") (62 . 5) (62 . 1) (-4 . "OR>") )))

I would only trust Autodesk or an OFFICIAL reseller to purchase Autodesk products. You might look into DraftSight® as well. There are other alternatives that are low cost as well, this list isn't up to date, but still relevant I think. Low cost CAD programs. - Useful Links - AutoCAD Forums

Hi Maahee If what you're looking for is a mix of the two, maybe this is what you're looking for? (ssget "_X" (list (cons 0 "LWP*") '(-4 . "<and") '(-4 . "<not") '(-4 . "=,=,*") (list 10 (car p1) (cadr p1)) '(-4 . "not>") '(-4 . "<or") '(62 . 1) '(62 . 2) '(-4 . "or>") '(-4 . "and>") ) )

Hi @maahee, Try with this: (setq ln (ssget "_F" pts '((0 . "LINE") (-4 . "<NOT") (-4 . "<OR") (62 . 1) (62 . 5) (62 . 256) (-4 . "OR>") (-4 . "NOT>")))) This will reject selecting "LINE" entities which are colored in red, blue and bylayer (62 . 256) (bylayer present that LINE which cross over the red and blue LINE's). Use this reference to all "ssget" function reference: ssget.

Bricscad and Autocad are virtually identical, so there's no learning curve. If you know Autocad you can use Bricscad. They have a trial version. You should download and check it out. https://www.bricsys.com/

Not a lot you can do, if the project time and budget allows we can always create a DWG from any supplied data, PDFs included. You could make it a hassle to convert, use anything apart from true type fonts might get converted as lines. Explode dashed lines, centre etc to individual parts. Explode all blocks, polylines, texts, mtexts, delete hatch boundaries, offset all lines a very small amount in any direction, flatten the drawing to layer 0, set a few random entities at a Z value other than where they should be, convert arcs, circles, polyline bulges to straight line equivalents, Insert specific drawing styles, names and so on that identify you as the drawing owner (sheep as a full stop are my favourite). You could convert such a PDF back to CAD but make it very tricky to work with. A these steps can be automated if necessary, remember don't save the drawing once it is messed up. How far you want to annoy anyone wanting to convert the PDF is up to you, all you are doing is slowing down the conversion, maybe to an extent that it isn't worth it. It can always be converted back though.... even if it is redrawn 99%

I hadn't realized. There's a problem with the 3DFACEs in your drawing. Normally, the first and last points coincide. But in your drawing, the first and second points coincide. If you want to solve it you can use this code: (defun c:ajusta3DFACEs (/ cj ent lstent p1 p2 p3 p4 n r la c) (if (setq cj (ssget "x" '((0 . "3DFACE")))) (while (setq ent (ssname cj (setq n (if n (1+ n) 0)))) (setq lstent (entget ent) r nil la nil c 9) (foreach l lstent (if (member (car l) '(10 11 12 13)) (if la (if (not (equal (cdr l) (cdr la) 1e-8)) (setq r (cons (cons (setq c (1+ c)) (cdr l)) r) la l) ) (setq r (cons (cons (setq c (1+ c)) (cdr l)) r) la l) ) ) ) (if (= (length r) 3) (entmod (append (reverse (cdr (member (assoc 10 lstent) (reverse lstent)))) (reverse (cons (cons 13 (cdr (last r))) r)) (list (assoc 70 lstent)) ) ) ) ) ) )

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

@thecocuk07 See attached .. it's a point grouped to an mleader with a field linked to it. example.dwg

Hi @thecocuk07, Yes, it is possible. You can make dynamic block with those properties and every time when you change the position of the "base point of the block", you will get desired X, Y, Z position. Best regards.

Try this modification of your code - minimally tested, but I am exploiting using inters and polar to work with linear, rotated, or aligned dimensions at any angle. Doesn't do anything on any other type of dimension. (defun C:D2 (/ cmd osm olderr ss PT index DS N13 N14) (setq cmd (getvar "CMDECHO") osm (getvar "OSMODE") olderr *error* *error* myerror ) (princ "Please select dimension object!") (setq ss (ssget '((0 . "DIMENSION")))) (setq PT (getpoint "\nPoint to trim or extend:") PT (trans PT 1 0) ) (command "UCS" "_W") (repeat (setq index (sslength ss)) (setq DS (entget (ssname ss (setq index (1- index)))) dtyp (cdr (assoc 70 ds)) ) (cond ((member dtyp (list 32 160))(setq ang (cdr (assoc 50 ds)))) ((member dtyp (list 33 161))(setq ang (angle (cdr (assoc 13 ds)) (cdr (assoc 14 ds))))) ) (if ang (progn (setq n13 (inters (cdr (assoc 13 ds)) (polar (cdr (assoc 13 ds)) (+ ang (/ pi 2)) 1) pt (polar pt ang 1) nil ) ds (subst (cons 13 n13) (assoc 13 ds) ds) n14 (inters (cdr (assoc 14 ds)) (polar (cdr (assoc 14 ds)) (+ ang (/ pi 2)) 1) pt (polar pt ang 1) nil ) ds (subst (cons 14 n14) (assoc 14 ds) ds) ) (entmod ds) ) ) ) (command "UCS" "_P") (setvar "CMDECHO" cmd) (setvar "OSMODE" osm) (setq *error* olderr) (princ) )

If you can create the layouts from your LISP but just need to adjust the rectangular view this might be a 'fix', will only really work for orthogonal rectangles. Double click in the view port, run this LISP, select the rectangle area to be shown in that view port. ;;https://forums.autodesk.com/t5/autocad-forum/having-trouble-with-the-lisp-that-zooms-a-rectangle-that-fits-in/td-p/9378532 (defun c:zvprect ( / a b e o) ;; I renamed this to fit my brain: 'z' - zoom, 'vp' - viewport, 'rect' - rectangle (if (setq e (car (entsel "\nSelect Rectangle : "))) (progn (setq o (vlax-ename->vla-object e)) (vlax-invoke-method o 'GetBoundingBox 'a 'b) (setq a (vlax-safearray->list a) b (vlax-safearray->list b) ) (vl-cmdf "_.zoom" a b) ) ) (princ) )

Give this a try .. seemed to work OK on your example drawing. (defun c:uunion (/ _off b e off reg regions s s2 sp tmp x) ;; RJP 09.18.2017 ;; UGLY effin code, but works on sample drawing .. can it be broken? But of course ;-) (defun _off (o d f / out tmp) (foreach di (list d (- d)) (if (not (vl-catch-all-error-p (setq tmp (vl-catch-all-apply 'vlax-invoke (list o 'offset di)))) ) (setq out (cons (car tmp) out)) ) ) (cond ((= 2 (length out)) (setq out (vl-sort out '(lambda (a b) (f (vla-get-area a) (vla-get-area b))))) (vla-delete (cadr out)) (car out) ) (car out) ) ) (or (setq off (getdist "\nPick distance to check < 15 >: ")) (setq off 15)) (if (and (setq sp (vlax-get (vla-get-activedocument (vlax-get-acad-object)) (if (= (getvar 'cvport) 1) 'paperspace 'modelspace ) ) ) (setq s (ssget ":L" '((0 . "insert")))) (setq s (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))) (setq s (mapcar '(lambda (x) (car (vlax-invoke x 'explode))) s)) (setq s2 (mapcar '(lambda (x) (car (_off x off >))) s)) (setq regions (vlax-invoke sp 'addregion s2)) ) (progn (mapcar 'vla-delete s) (mapcar 'vla-delete s2) (foreach reg regions (mapcar (function (lambda (x) (vl-catch-all-apply 'vla-boolean (list reg acunion x)))) (vl-remove reg regions) ) ) (setq b (vlax-ename->vla-object (setq e (entlast)))) (entmod (subst '(8 . "RJP_Outline") (assoc 8 (entget e)) (entget e))) (vlax-invoke b 'explode) (if (setq s (ssget "_x" '((0 . "line,arc,lwpolyline") (8 . "RJP_Outline")))) (if (= 1 (getvar 'peditaccept)) (command "_.pedit" "Multiple" s "" "Join" 0.0 "") (command "_.pedit" "Multiple" s "" "y" "Join" 0.0 "") ) ) (vla-delete b) (setq b (vlax-ename->vla-object (entlast))) (_off b off <) (vla-delete b) ) ) (princ) ) (vl-load-com)