All Activity

I have a simpler version kicking around at home that ill post later tonight.

oops forgot atoi to set X as an integer. in VBA you can just do math with strings if they are numbers "80" * 5 works the same as 80 * 5. not so much in lisp.

After many months of avoiding this issue when I switched offices. I found out this happens when linetypes are created with .shp files required. If you have an issue where the linetyepes show incorrectly please just do the following to fix. 1. Type "OPTIONS" 2. Go to FILES tab 3. Support File folder, and navigate to the file that holds your fonts files and move it to the top of the list. 4. Finally, close cad and reopen. The hierarchy of the support files a crucial to what it loads and displays in cad. It will ignore the file needed if it is not prioritized in the support file folder correctly. You are welcome

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)) (setq scl (AT:ListSelect "Set Viewport Scale" "Pick A Scale" 30 60 "False" lst)) (setq X (atoi (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 ) ) ) -edit Set x as integer with atoi

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