All Activity

hello : I found a good routine that I really like but I would like it to skip the last two steps. select areas in the model space and create the same number of viewports in the paperspace I want that when the viewports are finished being created, the routine ends and it no longer asks me if I want to return to the model or if I want to make more viewports. some help please. here code: ; NVM creates mspace vports ; Modified: ; 1. Vport layout placement is at lower left corner ; 2. Default setting to switch back to Model vs staying in Layout ; 3. Layout selection defaults to previous selection ; 4. Offers option to select multiple Model views ; 5. Offers dialog selection on scales based on ScalelistEdit ; 6. NVM loops until Esc or Enter during first point of view selection ; OP: ; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-create-multiple-viewport/m-p/12728443#M464938 (defun c:NVM (/ *error* _RestoreView _GetScaleProp ans count ct doc ll vpscl vpsclp mp p1 p2 ptlst res sc sci scitmp sl tmp vc vp vpdoc vpp vs ) (vl-load-com) (defun *error* (Msg) (princ "Error: ") (princ Msg) (if ct (_RestoreView)) (princ) ) (defun _RestoreView () (setvar "ctab" ct) (vla-ZoomCenter (vlax-Get-Acad-Object) (vlax-3d-Point (trans vc 1 0)) vs) ) ; _GetScaleProp returns list of scalelist name assoc with paper units & drawing units ; modified from: ; https://forums.augi.com/showthread.php?107333-Using-vlisp-to-access-scales-list (defun _GetScaleProp (/ csobj ent entnm index scaleDict scaleDictName scaleObject scllst sclnam unidwg unippr) (setq scaleDict (dictsearch (namedobjdict) "ACAD_SCALELIST")) (setq scaleDictName (cdar scaleDict)) (setq csobj (vlax-ename->vla-object scaleDictName)) (setq index 0) (repeat (vla-get-count csobj) ; loop through all scalelist names (setq scaleObject (vlax-invoke-method csobj 'item index)) (setq entnm (vlax-vla-object->ename scaleObject)) ; convert from obj to entity (setq ent (entget entnm)) ; get entity data (setq sclnam (cdr(assoc 300 ent)) ; scalelist name car itm unippr (cdr(assoc 140 ent)) ; paper units cadr itm unidwg (cdr(assoc 141 ent)) ; drawing units caddr itm scllst (append (list(cons sclnam (list unippr unidwg))) scllst) index (+ index 1) ) ) ; repeat (setq scllst (append scllst (list (list "User" 1.0 1.0)))) ; add user scale (reverse scllst) ) ; (if (/= (getvar "cvport") 1) ; add (progn (setq ; set Model defaults doc (vla-get-ActiveDocument (vlax-get-acad-object)) ct (getvar "ctab") vs (getvar "viewsize") vc (getvar "viewctr") ; start loop p1 T count 0 ; view count vpsclp (_GetScaleProp) ; get scalelist property vpscl (mapcar '(lambda (x) (car x)) vpsclp) ; create list of just first item in assoc pair for list box ll ; build layout list (vlax-for % (vla-get-layouts doc) (setq res (cons (list (vla-get-name %) % (vla-get-TabOrder %) ) res ) ) ) ll (cdr (vl-sort ll '(lambda (a b) (< (last a) (last b)) ) ) ) ) ; setq ; start loop (while p1 (setq ptlst '() count 0) ; reset count & layout list (while p1 ; (if (and (setq p1 (getpoint "\nSelect first point of view or Enter to Exit: ")) (setq p2 (getcorner p1 "\nSelect second point of view: ")) ) (progn ; build list of view points (setq ptlst (append ptlst (list (cons p1 (list p2))))) ; show # of views selected (if(zerop count) (princ (strcat "\n" (itoa (setq count (1+ count))) " View Selected...")) (princ (strcat "\n" (itoa (setq count (1+ count))) " Views Selected...")) ) ) ) ; if ) ; while (if ptlst ; if list of view points (progn ; (princ (strcat"\n" (itoa (length ptlst)) " Views Selected...")) ; add scale selection dialog (if(not sci) (if (not(setq sci (vl-position "1:50" vpscl))) ; select 1:50 as default (setq sci 1) ; else set 2nd item as default ) ) (if (setq scitmp (cd:DCL_StdListDialog vpscl sci "Viewport Scale" "Select Scale:" 40 15 2 nil T T)) (if (eq "User" (nth scitmp vpscl))(setq scitmp nil)(setq sci scitmp)) ) (if scitmp ; then get scale = 3rd item in the prop list (setq sc (fix(caddr(nth sci vpsclp)))) ; else type in scale (setq sc (cond ( (getint (strcat "\nWhat is Viewport Scale 1: <" (itoa (setq sc (cond (sc) (50)))) ">: " ) ) ) ( sc ) ) ) ) ; if ; add highlight of previous layout item selection (if(not sl)(setq sl 0)) (if (setq sl (cd:DCL_StdListDialog (mapcar ' car ll) sl "NewViewport" "Select layout:" 40 15 2 nil T T)) ; (progn (setvar "ctab" (car (nth sl ll))) (vla-put-MSpace doc :vlax-false) ; cycle through all selected view points (setq count 1) (foreach itm ptlst (setq p1 (car itm) p2 (cadr itm) ) ; (if (setq vpp (getpoint (strcat "\nSelect Point for " (itoa count) " of " (itoa (length ptlst)) " Viewports: "))) (progn (if (< (car (trans p2 1 0)) (car (trans p1 1 0)) ) (setq tmp p1 p1 p2 p2 tmp) ) (setq mp (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2) 0.0 ) ) (setq vpdoc (vla-get-PaperSpace doc) vp (vla-AddPViewport vpdoc ; move vport so placement point is at lower left corner ; (vlax-3d-point vpp) (vlax-3d-point (list (+ (car vpp) (/ (abs (/ (- (car p2) (car p1)) sc)) 2) ) (+ (cadr vpp)(/ (abs (/ (- (cadr p2) (cadr p1)) sc)) 2) ) 0.0 ) ) ; (abs (/ (- (car p2) (car p1)) sc)) (abs (/ (- (cadr p2) (cadr p1)) sc)) ) ) (vla-display vp :vlax-true) (vla-put-MSpace doc :vlax-true) (vla-put-ActivePViewport doc vp) (vla-ZoomCenter (vlax-get-acad-object) (vlax-3d-point mp) 1.0 ) (vla-put-CustomScale vp (/ 1. sc)) (vla-put-MSpace doc :vlax-false) (vla-put-DisplayLocked vp :vlax-true) ) (progn (princ "\n** Invalid Point ** ") (if ct (_RestoreView)) ) ) ; (setq count (1+ count)) ) ; foreach ; ) ; progn (princ "\n** Layout not selected ** ") ) ; set default (if(not *ans*)(setq *ans* "Yes")) ; (initget "Yes No") (setq ans (cond ; ( (getkword "\nBack to model space [Yes/No] <No>: ") ) ( (getkword (strcat "\nBack to model space [Yes/No] <" *ans* ">: ")) ) ( *ans* ) ; ( "No" ) ) ) ; reset default (setq *ans* ans) ; (if (= ans "Yes") (_RestoreView)) ; ) ; progn ptlist (princ "\n** Invalid Point ** ") ) ; if ; ) ; while ) ; progn ; add loop end (princ "\nStart Program in Model Space ") ) (princ) ) ; defun NVM ; =========================================================================================== ; ; Okno dialogowe z lista (list_box) / Dialog control with list (list_box) ; ; Data [list] - lista do wyswietlenia / list to display ; ; Pos [INT] - pozycja poczatkowa na liscie / select list position ; ; Title [STR/nil] - tytul okna / window title ; ; ListTitle [STR/nil] - tytul list_box / list_box title ; ; Width [INT] - szerokosc / width ; ; Height [INT] - wysokosc / height ; ; Btns [0/1/2] - [cancel/ok/ok_cancel] przyciski / buttons ; ; MSelect [T/nil] - dopuszczenie multiple_select / allow multiple select ; ; DPos [T/nil] - zapamietanie pozycji okna / save window position ; ; DblClick [T/nil] - podwojny klik (wykluczone Cancel) / double click (not for Cancel) ; ; ------------------------------------------------------------------------------------------- ; ; Zwraca / Return: ; ; nil = nic nie wybrano (anulowano) / nothing was selected (canceled) ; ; INT = wybrano jedna pozycje / one position selected | MSelect = nil ; ; LIST = wybrano kilka pozycji / few positions selected | MSelect = T ; ; ------------------------------------------------------------------------------------------- ; ; (cd:DCL_StdListDialog '("A" "B" "C") 0 "Title" "ListTitle:" 40 15 2 nil T nil) ; ; =========================================================================================== ; (defun cd:DCL_StdListDialog (Data Pos Title ListTitle Width Height Btns MSelect DPos DblClk / f tmp dc res) (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1))) (cond ( (not (and (setq f (open (setq tmp (vl-FileName-MkTemp nil nil ".dcl")) "w" ) ) (foreach % (list "StdListDialog:dialog{" (strcat "label=\"" (if Title (strcat Title "\";") "\"\";") ) ":list_box{key=\"list\";" (if ListTitle (strcat "label=\"" ListTitle "\";")"" ) "fixed_width=true;fixed_height=true;" (strcat "width=" (if (not Width) "20" (itoa Width))";" ) (strcat "height=" (if (not Height) "20" (itoa Height))";" ) (if (not DblClck) (strcat "multiple_select=" (if MSelect "true;" "false;") ) "multiple_select=false;" ) "}" (cond ( (zerop Btns) "cancel_button;") ( (= 1 Btns) "ok_only;") (T "ok_cancel;") ) "}" ) (write-line % f) ) (not (close f)) (< 0 (setq dc (load_dialog tmp))) (new_dialog "StdListDialog" dc "" (cond ( *cd-TempDlgPosition* ) ( (quote (-1 -1)) ) ) ) ) ) ) ( T (start_list "list") (mapcar (quote add_list) Data) (end_list) (if (not Pos) (setq Pos 0) (if (> Pos (length Data)) (setq Pos 0)) ) (setq res (set_tile "list" (itoa Pos))) (action_tile "list" (strcat "(setq res $value)(if DblClk (if(or(not MSelect)" "(not (zerop Btns)))" "(if (= $reason 4)(setq " "*cd-TempDlgPosition* (done_dialog 1)))))" ) ) (action_tile "accept" "(setq *cd-TempDlgPosition* (done_dialog 1))") (action_tile "cancel" "(setq res nil) (done_dialog 0)") (setq res (if (= 1 (start_dialog)) (read (strcat "(" res ")")) nil ) ) ) ) (if (< 0 dc) (unload_dialog dc)) (if (setq tmp (findfile tmp)) (vl-File-Delete tmp)) (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1))) (if res (if (= 1 (length res)) (car res) res)) ) (princ "\n Type NVM to Invoke ") (princ) thanks

I agree, then there will be another version.: ;; Rectangle on the non-printable "LayDef" layer, LWEIGHT 0.5, color 2 yellow ;; Based on the Lee Mac code 02.10.2025 (defun c:RectLayDef_N ( / cec cel cla ) (setq cec (getvar 'cecolor)) (setvar 'cecolor "2") (setq cel (getvar 'celweight)) (setvar "celweight" 50) (setq cla (getvar 'clayer)) (command "_.-LAYER" "_M" "LayDef" "_C" 2 "LayDef" "_LW" 0.50 "LayDef" "_P" "_N" "LayDef" "") (setvar 'clayer "LayDef") (initcommandversion) (vl-cmdf "_.rectang") (while (= 1 (logand 1 (getvar 'cmdactive))) (vl-cmdf "\\")) (setvar 'cecolor cec) (setvar 'celweight cel) (setvar 'clayer cla) (princ) )

It worked successfully. But I need ctrl + z to get true results. Because it was run automatically this code: "Change ByBlock to ByLayer? [Yes/No] <Yes>:". If you have time, please edit code to fix this. I run on autocad 2021. Thank you

I renamed your thread, please use descriptive titles.

You should avoid using Defpoints layer, Defpoints layer in AutoCAD is automatically created when dimensions are added and is intended to hold definition points for those dimensions. While some users may place objects on this layer to prevent them from printing, it is generally not recommended as it can lead to unexpected issues in the drawing. Create a new no plot layer instead and use that.

For those who don't like clouds Sometimes you need to highlight something and you can forget that the frame needs to be deleted. ;; Rectangle on the Defpoints layer, LWEIGHT 0.5, color 2 yellow ;; Based on the Lee Mac code (defun c:RectLayDefcol2 ( / cec cel cla ) (setq cec (getvar 'cecolor)) (setvar 'cecolor "2") (setq cel (getvar 'celweight)) (setvar "celweight" 50) (setq cla (getvar 'clayer)) (command "_.-LAYER" "_M" "Defpoints" "") (initcommandversion) (vl-cmdf "_.rectang") (while (= 1 (logand 1 (getvar 'cmdactive))) (vl-cmdf "\\")) (setvar 'cecolor cec) (setvar 'celweight cel) (setvar 'clayer cla) (princ) )

It's brilliant! The revcloud is immediately drawn as a cloud! Thanks!

Another using radio buttons. (if (not AH:Butts)(load "Multi Radio buttons.lsp")) (if (= but nil)(setq but 1)) (setq ans (ah:butts but "V" '("Choose a Scale" "1:10" "1:20" "1:50" "1:100" "1:200" "1:250" "1:500" "1:1000"))) ; ans holds the button picked as an integer value or Multi radio buttons.lsp

Shout out to @alanjt for doing the heavy lifting here. This will generate a temp DCL Menu with a list provided and whatever you pick will change the scale accordingly. could be cleaned up a bit with error handling of making sure you selected a viewport or if your in an active viewport pick that one by default. ;;----------------------------------------------------------------------------;; ;; Generates DCL Menu for user to select a veiwport Scale (defun C:VPS () (C:VPSCALE)) (defun C:VPSCALE (/ lst vp) (vl-load-com) (setq Doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark Doc) (setq lst '("1:1" "1:5" "1:10" "1:15" "1:20" "1:30" "1:40" "1:50" "1:60" "1:70" "1:80" "1:90" "1:100")) ;update list how you see fit (if (setq vp (car (entsel "\nSelect viewport: "))) (progn (setq vp (vlax-ename->vla-object vp) scl (AT:ListSelect "Set Viewport Scale" "Pick A Scale" 30 60 "False" lst) X (substr scl 3) ) (vla-put-CustomScale vp (/ 1.0 X)) (vla-Regen Doc acAllViewports) ;might not be needed (princ (strcat "\nViewport scale set to " scl)) ) ) (vla-endundomark Doc) (princ) ) ;;----------------------------------------------------------------------------;; ;; Function to Pick form list ;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite) ;; (AT:ListSelect "Title" "Lable" Height Width "true/false multi select" lst) ;; some coding borrowed from http://www.jefferypsanders.com (thanks for the DCL examples) (defun AT:ListSelect (title label height width multi lst / fn fo d f) (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w")) (write-line (strcat "list_select : dialog { label = \"" title "\"; spacer;") fo) (write-line (strcat ": list_box { label = \"" label "\";" "key = \"lst\";") fo) (write-line (strcat "allow_accept = true; height = " (vl-princ-to-string height) ";") fo) (write-line (strcat "width = " (vl-princ-to-string width) ";") fo) (write-line (strcat "multiple_select = " multi "; } spacer; ok_cancel; }") fo) (close fo) (new_dialog "list_select" (setq d (load_dialog fn))) (start_list "lst") (mapcar (function add_list) lst) (end_list) (setq item (set_tile "lst" "0")) (action_tile "lst" "(setq item $value)") (setq f (start_dialog)) (unload_dialog d) (vl-file-delete fn) (if (= f 1) ((lambda (s / i s l) (while (setq i (vl-string-search " " s)) (setq l (cons (nth (atoi (substr s 1 i)) lst) l)) (setq s (substr s (+ 2 i))) ) (reverse (cons (nth (atoi s) lst) l)) ) item ) ) )

hello: I'm trying to make a routine that adds new scale to my viewports I want the routine to only ask me a scale number. example . 20 and it generated the scale 1:20 and so on for others I started with this code but something happens and it doesn't work (defun c:EVP3 (/ ESC ESC2) (setq old_err *error*)(defun *error* ( a / )(princ "") (setq *error* old_err)(princ)) (setvar "cmdecho" 0) (setq ESC (getreal "\nIndica la escala: ")) (setq ESC2 (strcat "1" ":" ESC)) (command "_-SCALELISTEDIT" "A" ESC2 ESC2 "E") (princ) );fin defun enlighten me masters ... please thanks

You can put the prompts in the getpoint. Note the \n this is make a new line on command prompt. (prompt "Specify the first point of the rectangle: ") (setq p1 (getpoint)) (prompt "Specify the opposite point of the rectangle: ") (setq p2 (getcorner p1)) ; *** rlx (setq p1 (getpoint "\nSpecify the first point of the rectangle: ")) (setq p2 (getcorner p1 "\nSpecify the opposite point of the rectangle: ")) ; *** rlx

Just be aware a 3dface is normally 4 points, making a 3dpoly with 3 sides is a different object so import to CIV3D etc may not work without extra steps.

I use Bricscad and it found an open Access, maybe some one else with ACAD can check. (setq Access (vl-catch-all-apply 'vlax-get-or-create-object '("Access.Application"))) (vlax-put-property Access 'Visible :vlax-true)

Another - (defun c:rectrevclcol ( / cec ) (setq cec (getvar 'cecolor)) (setvar 'cecolor "2") (initcommandversion) (vl-cmdf "_.revcloud" "_a" 500 "_r") (while (= 1 (logand 1 (getvar 'cmdactive))) (vl-cmdf "\\")) (setvar 'cecolor cec) (princ) )

Super! Right in the bull's-eye! Thanks! **** (defun c:RectRevClCol (/ p1 p2 ssRect ssCloud) (prompt "Specify the first point of the rectangle: ") (setq p1 (getpoint)) (prompt "Specify the opposite point of the rectangle: ") (setq p2 (getcorner p1)) ; *** rlx (command "_.RECTANGLE" p1 p2) (setq ssRect (ssget "_L")) (if ssRect (progn (command "_REVCLOUD" "_Object" ssRect "" "_ArcLength" "500" "") (setq ssCloud (ssget "_L")) (if ssCloud (command "_.CHPROP" ssCloud "" "_Color" "2" "") ) ) ) (princ) )

or instead of using (setq p2 (getpoint p1)) try (setq p2 (getcorner p1))

Might have to study GrRead and GrDraw to do that.

I would like to see the frame when drawing the rectangle, as in the standard autocad command. If you only call the RECTANGLE command without passing points to it, then AutoCAD will enable the standard interactive construction. If you remove from the line (command "_.RECTANGLE" p1 p2) p1 and p2 (command "_.RECTANGLE"), then the code does not work further, that is, the cloud is not drawn. (defun c:RectRevClCol (/ p1 p2 ssRect ssCloud) (prompt "Specify the first point of the rectangle: ") (setq p1 (getpoint)) (prompt "Specify the opposite point of the rectangle: ") (setq p2 (getpoint p1)) (command "_.RECTANGLE" p1 p2) (setq ssRect (ssget "_L")) (if ssRect (progn (command "_REVCLOUD" "_Object" ssRect "" "_ArcLength" "500" "") (setq ssCloud (ssget "_L")) (if ssCloud (command "_.CHPROP" ssCloud "" "_Color" "2" "") ) ) ) (princ) )

Have you tried CadTools?

Hi I found a solution, started my hollidays, and forgot to post here. SORRY! @BlackBox, I think you misunderstood. The problem is that if you try to open another application from AutoCAD Lisp code on the same PC (not on another PC, nor with another user: I'm the only user on my PC), administrator privileges are likely required. @BIGAL vlax-get-or-create-object doesn't seem to be able to control an already running application. At least I couldn't do it with an already open Access instance. In the end, I resigned myself to the idea that it's not possible to control a running Access instance and just considered creating a new instance. Thanks everyone for the help.

Another option: Keeping the original entity and removing any repeated points along the 3D polyline. (defun supriPts3DPol (e / l p lp vlae) (setq vlae (vlax-ename->vla-object e)) (while (/= (cdr (assoc 0 (setq l (entget (setq e (entnext e)))))) "SEQEND") (if (not (equal (setq p (cdr (assoc 10 l))) (car lp) 1e-4)) (setq lp (cons p lp))) ) (vlax-put vlae 'Coordinates (apply 'append (mapcar '(lambda(p) (mapcar 'float p)) lp))) )

I am working with point cloud data in AutoCAD and facing difficulty cleaning unnecessary points. When using crop or section tools in top view, the ceiling and floor points also get removed. Is there a way to create a true limit box, similar to Trimble RealWorks, that allows selective cleaning?, i can only use autocad, it is a assignment

Another way not as compact but a little easier to read/follow. Would also handle if uscfollow wasn't 1 or 0 Tho i don't know when/if that would ever happen. ;; Toggle UCSFOLLOW using COND (defun c:foo (/ v) (setq v (getvar "UCSFOLLOW")) (cond ((= v 1) ;; If it's currently ON turn it OFF (setvar 'UCSFOLLOW 0) (princ "\nUCSFOLLOW Desactivado") ) ((= v 0) ;; If it's currently OFF turn it ON (setvar "UCSFOLLOW" 1) (princ "\nUCSFOLLOW Activado") ) (T ;; If it’s some unexpected value, default to OFF (setvar "UCSFOLLOW" 0) (princ "\nUCSFOLLOW Desactivado") ) ) (princ) )

When working in AutoCAD, you’ll likely modify or duplicate objects more often than create new ones. To modify and duplicate objects, AutoCAD offers a wide range of options to select objects, giving you the flexibility to meet your needs. Today, we’ll look at a few ways to select, modify and duplicate objects. For the full tutorial, check out the AutoCAD Foundations article. Let’s start with a few quick tips to get you started. How to Select Multiple Objects First things first! You’ll need to select objects before you can modify or duplicate them. You can select multiple objects in an area by clicking an empty location (#1 in image), moving your cursor right or left, and then clicking a second time (#2 in image ). Based on the direction you select objects, you define a crossing or window selection. With a crossing selection, any objects within or touching the green area (in image below) are selected. With a window selection, only the objects completely contained within the blue area (also illustrated in image below) are selected. How to Erase Objects in AutoCAD As a design evolves, some objects that were previously added may no longer be needed. To remove an object, first select it by positioning the pickbox over the object and clicking. The pickbox appears at the center of the crosshairs when no command is active, or as a simple square cursor when a command is active and you’re being prompted to select objects. When objects are selected, they form a selection set, which is the group of objects that will be removed. Quick Tip: The most recently erased objects can be restored with the OOPS command. So if you created or modified any objects after erasing objects, those erased objects can be restored without undoing other recent changes. How to Move Objects in AutoCAD Moving objects in a drawing is one of the most basic ways to modify objects. Simply select the objects to be moved and then specify a base point followed by a second point to determine the distance and direction of the move. How to Duplicate Objects in AutoCAD You will often want to duplicate and reuse elements of your design. To do this, follow the same steps used to move objects: select the objects you want to duplicate, then specify two points to define where the new objects should be created. Advance to New Levels This just scratches the surface of selecting, modifying, and duplicating objects in AutoCAD. Get to the next level by learning how to rotate and scale; offset; mirror; trim and extend; fillet and chamfer; stretch; and more in the AutoCAD Foundations: Select, Modify, and Duplicate Objects article. The post Modify and Duplicate Objects in AutoCAD: Autodesk Foundations appeared first on AutoCAD Blog. View the full article