Leaderboard

This snippet should set up a page to ISO 'A' paper sizes with the standard things I use. Might be useful starting point. For example PSA1L is A1 drawing, layout, PSA1P is the same but portrait. For a batch process you might need to include some code to go to the layout sheet you want to set up and then run this ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Default page setup and set paper size as required: (defun psAx( Ax Width Height / pagesize orientation aplotsize) (setq pagesize (strcat "ISO_" Ax "_(" (itoa Width) ".00_x_" (itoa Height) ".00_MM)")) (c:defaultpagesetup) (setq aplotsize pagesize) (setq orientation ac0Degrees) (vla-put-canonicalmedianame (vla-item (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) (getvar 'ctab)) aplotsize) (setq layoutname (vla-get-name (vla-get-ActiveLayout (vla-get-activedocument (vlax-get-acad-object ))))) (setq AD (vla-get-activedocument (vlax-get-acad-object ))) ;;AD: Active Document (setq AL (vla-get-ActiveLayout AD)) ;;AL: Active Layout ;; (vla-get-PlotRotation AL) ;;Get plot rotation (vla-put-PlotRotation AL orientation) ;;Set orientation (vla-put-PaperUnits al acMillimeters) ;;set mm (vla-put-CenterPlot AL :vlax-true) ;;center the plot (vla-put-PlotType AL acExtents) ;;set to extents (command "regen") ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:psA4L()(psAx "A4" 297 210)(princ) ) (defun c:psA3L()(psAx "A3" 420 297)(princ) ) (defun c:psA2L()(psAx "A2" 594 420)(princ) ) (defun c:psA1L()(psAx "A1" 841 594)(princ) ) (defun c:psA0L()(psAx "A0" 1189 841)(princ) ) (defun c:psA4P()(psAx "A4" 210 297)(princ) ) (defun c:psA3P()(psAx "A3" 297 420)(princ) ) (defun c:psA2P()(psAx "A2" 420 594)(princ) ) (defun c:psA1P()(psAx "A1" 594 841)(princ) ) (defun c:psA0P()(psAx "A0" 841 1189)(princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Thanks pkenewell !!! It works perfect.

You can use SSGET "WP" PTS where pts are a list of pts taken from your pline. It will return nil if nothing inside. You need the extra point to make a closed pline. (setq plent (entsel "\nPick rectang")) (if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))) (setq co-ord (cons (car co-ord) co-ord)) Note if you have arcs in the pline need extra code as bulge will not be considered.

@aarong85 try this. I sometimes struggle with writing and reading to and from the registry. ;; https://www.cadtutor.net/forum/topic/37515-moving-text-block-to-adjacent-point/?do=findComment&comment=566551 ;; Text 2 Point - Lee Mac 2012 ;; Prompts for a selection of Text and Point entities and moves ;; each Text entity to the nearest (2D distance) Point entity in the set. ;; ;; Retains existing Text elevation. ;; ;; MODIFICATIONS BY 3DWANNAB ;; Link https://www.cadtutor.net/forum/topic/37515-moving-text-block-to-adjacent-point/?do=findComment&comment=605448 ;; ;; Modified on 2022.11.18 by 3dwannab. ;; - Added INSERT along with POINT to the selection. ;; - Added undo handling. ;; - Prompt to pick fuzz value. ;; - Retain slection after the command. ;; ;; Modified on 2023.03.30 by 3dwannab. ;; - Added MTEXT and CIRCLES to the program. ;; ;; Modified on 2024.05.14 by 3dwannab. ;; - Added a while loop to the program to allow user to choose different fuzz distance values. ;; - Added selection of the modified objects after the code has finished. Handled in the error handler. ;; ;; Credit to Lee Mac for the original coede ;; (vl-load-com) (defun c:Text_2_Point_Or_Block (/ *error* acDoc _textinsertion _MergeSelectionSets dcd di1 di2 dxf ent entname inc ins lst pnt regFuzz ss1 txt ListOfSSs) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (if ListOfSSs (progn (sssetfirst nil (_MergeSelectionSets ListOfSSs)) (command-s "_.REGEN") ) ) ) (defun _textinsertion (elist) (if (or (= "MTEXT" (cdr (assoc 0 elist))) (and (zerop (cdr (assoc 72 elist))) (zerop (cdr (assoc 73 elist))) ) ) (assoc 10 elist) (assoc 11 elist) ) ) ;; Credit: https://www.cadtutor.net/forum/profile/23626-grrr/ ;; https://www.cadtutor.net/forum/topic/61683-adding-selection-set-items-to-one-set/?do=findComment&comment=509167 (defun _MergeSelectionSets (ListOfSSs / Lst nSS) (if (apply 'and (mapcar '(lambda (x) (= 'PICKSET (type x))) ListOfSSs)) (progn (setq nSS (ssadd)) (mapcar (function (lambda (x / i) (repeat (setq i (sslength x)) (ssadd (ssname x (setq i (1- i))) nSS) ) ) ) ListOfSSs ) ) ) nSS ) (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)) (while (progn ;; Get saved value from the registry or default to 1 (setq regFuzz (read (cond ((getenv "Text_2_Point_Or_Block_Fuzz_Value")) (1)))) (setq regFuzz (cond ((getdist (strcat "\nPick or enter the gap tolerance to move the TEXT to POINTS or BLOCKS :\nCurrent value <" (vl-princ-to-string (getenv "Text_2_Point_Or_Block_Fuzz_Value")) ">: " ) ) ) (regFuzz) ) ) ;; Set the registry value to the variable (setenv "Text_2_Point_Or_Block_Fuzz_Value" (vl-princ-to-string regFuzz)) (princ "\nSelect point and text objects...\n") (if (setq ss1 (ssget "_:L" '((0 . "POINT,INSERT,CIRCLE,TEXT,MTEXT")))) (progn (repeat (setq inc (sslength ss1)) (setq ent (entget (setq entname (ssname ss1 (setq inc (1- inc)))))) (if (or (eq "POINT" (cdr (assoc 0 ent))) (eq "CIRCLE" (cdr (assoc 0 ent))) (eq "INSERT" (cdr (assoc 0 ent))) ) (setq lst (cons (cdr (assoc 10 ent)) lst)) (setq txt (cons (cons (_textinsertion ent) ent) txt)) ) ) (foreach ent txt (setq ins (list (cadar ent) (caddar ent))) (if (setq pnt (vl-some '(lambda (pnt) (equal ins (list (car pnt) (cadr pnt)) 1e-8)) lst)) (setq lst (vl-remove pnt lst)) (progn (setq di1 (distance ins (list (caar lst) (cadar lst))) mpt (car lst) ) (foreach pnt (cdr lst) (if (< (setq di2 (distance ins (list (car pnt) (cadr pnt)))) di1) (setq di1 di2 mpt pnt ) ) ) (if (< di1 regFuzz) (progn (setq pnt (list (car mpt) (cadr mpt) (caddar ent)) dcd (caar ent) dxf (cdr ent) dxf (subst (cons dcd pnt) (assoc dcd dxf) dxf) ) (entmod dxf) (setq lst (vl-remove mpt lst)) ) ) ) ;; progn ) ;; if pnt ) ;; foreach ) ;; progn ) ;; if selection (setq ListOfSSs (cons ss1 ListOfSSs)) ) ;; progn ) ;; while (*error* nil) (princ) ) ;; defun ; (c:Text_2_Point_Or_Block) ;; Use for testing only