Jump to content

All Activity

This stream auto-updates

  1. Past hour
  2. TRY (vl-cmdf "._layout" "c" layout-orientation layout-name)
  3. Today
  4. You can tell AutoCAD to temporarily suspend view updates to speed up AutoLISP operations like creating layouts Never mind, The REGENMODE system variable is no longer needed and is not functional. needed mindpoint of UR LL and the length and width of the rectangle to create the view port. (vla-startundomark (setq Drawing (vla-get-activedocument (vlax-get-acad-object)))) ;while setting up drawing just also add a undo mark ... (acet-ui-progress-init "Creating Layouts..." total) (foreach plan border-list (setq layout-name (car plan) LL (cadr plan) UR (caddr plan) MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2)) ;midmpoint L&W (mapcar '- UR LL) ;returns a point that is the length and width (X,Y) of the rectangle layout-orientation (last plan) ;don't know what this is angle? ) (setq layouts (vla-get-Layouts Drawing)) (setq newLayout (vla-Add layouts layout-name)) ;could error if layout-name is existing? (vla-Activate newLayout) ;; Activate the new layout (setq ps (vla-get-PaperSpace Drawing)) ;switch to PaperSpace on new layout ;; Create a viewport at MPT, Length, Width (setq vp (vla-AddPViewport ps (vlax-3d-point MPT) (cadr L&W) (car L&W))) (setq i (1+ i)) ;I like i for counting (acet-ui-progress-safe i) ;instead of spamming command prompt, output to window or status bar ;(princ (strcat "\n" (itoa done) "/" (itoa total))) ) (acet-ui-progress-done) ... (vla-endundomark Drawing) (vla-Regen Drawing acAllViewports) or zoom to rectangle and copy these system variables (setq vc (getvar 'viewctr)) (setq sz (getvar 'viewsize)) (vla-zoomcenter Drawing VC SZ)
  5. Danielm103

    Detecting privileges with Lisp

    I think vlax-get-or-create-object will get the instance, if the process was created by the same user, so I don’t think you can start an application as admin, then connect to it from another user. I also don’t think you can use vlax-get-or-create-object in an attempt to elevate privileges To me the whole thread goes not make sense. If you want to connect to a database, use SQL express and assign connection rights from the server. Use a file based server like SQLite
  6. When you say slows down, I have something similar and have made 40+ layouts in one go and just watch the screen flash, if you compare the time to make 40+ layouts its so much faster. Maybe ;; Set active layout (setq layname (vla-Item layouts (1- (vla-get-Count layouts)))) (vla-put-ActiveLayout doc layname) (setvar 'ctab layname) My code looks at what title block to use and what scale the rectangs are to represent, the rectangs can be rotated so viewport is twisted. yes have a version that allows the rectangs to be different tittle blocks. There is other make layouts lisp out there maybe have a look at what method used to create the layouts.
  7. BIGAL

    Autolisp to make holes

    Try this change, the problem is in using entmake. (entmake (list (cons 0 "circle")(cons 10 (trans lstpnt 1 0))(cons 40 (/ hole 2.0)))) Just a comment for multiple "please enter value" a dcl is a simpler way to go, here is an example and it has set default values as you need. You can make a dcl which also has the "Left right option as well. Just look in the top of the code attached. I use it to write the dcl then would add the left right option manually, the second step is using the RLX code to convert the dcl into lisp code so its all in one program rather than 2 files. (setq ans (AH:getvalsm (list "Enter values " "Number rows" 5 4 "1" "Number columns " 5 4 "1" "Beamm Guage" 5 4 "3" "Vertical Cetre" 5 4 "3" "Horizontal centre" 5 4 "3" "Hole dia" 5 4 "0.8125"))) Multi GETVALS.lspConvert dcl 2 lisp rlx.lsp
  8. I should have read the code by PGia closer (setq Access (vl-catch-all-apply 'vlax-create-object '("Access.Application"))) Instead use (setq Access (vl-catch-all-apply 'vlax-get-or-create-object '("Access.Application"))) The get or create means if it is open then make application, if it is not open it will open Access. I have never had a problem opening Word or Excel with lisp. Same with are they open already. @PGia its your turn to respond, The code should work.
  9. Yesterday
  10. did a little cleaning & tweaking and added a (grdraw) background to give it just a tiny bit more spunk ... enjoy ;;; RlxGrMenu - 2025-07-09 - Just a funny / basic / tiny 'toolbar' ;;; It draws a column on the right of your screen with 12 rows. ;;; Config is not working yet and I'm not sure it's worth the effort because its only meant as a lisp launcher. ;;; Quit by click on QUIT in toolbar or by typing Q , q or space, zoom in / out with +/-/z ;;; I've run a little out of button-space so wanted an out of the box solution to this problem. ;;; this is just a way to run my 10 most used lisp routines, nothing more , nothing less. ;;; Substitute the names in app-list (setq app-list (list "LC" "VT"...) with names from your own favorite apps ;;; Apps (lisps) have to be in search path so (findfile (strcat "MyApp" ".lsp") should work. ;;; Also apps should not be self executing and the start command should be same as app name. ;;; If your app is named "MyApp" this routine loads the app if found and starts it with (eval (read (strcat "C:" "Myapp"))) ;;; have fun ;;; ------------------------------ ;;; ;;; |S1 S2| ;;; ;;; | -------------- ----- [a]| ;;; ;;; | |E1 E2| [b]| ;;; ;;; | | | [c]| ;;; ;;; | | | [d]| ;;; ;;; | |E3 E4| [e]| ;;; ;;; | -------------------- [f]| ;;; ;;; |S3 S4| ;;; ;;; ------------------------------ ;;; ;;; (count_calcula) : run time values for viewsize / viewcenter etc ;;; values are effected by resize window : vc , vs , ss , x+ , x- , y+ , y- , P1-P4 ;;; screen corner points : S1 = (x- y+) , S2 (x+ y+) , S3 (x- y-) , S4 (x+ y-) ;;; extents corner points : E1 - E5 extmin / extmax ;;; viewsize : vs - height current viewport (drawing units) (i.e. 300 / 386 after resize) ;;; screen size : ss (1187 532) (pixels) after max acad window : vs = 386 , ss = (1840 685) ;;; - 12 rows, 1-10 for user , 11 for config , 12 for exit ;;; - height each row = viewsize / 12, row width = 2 x row height ;;; cell-ip = (list (- (fix x+) cell-size) (fix y+)) ;;; vector draw cell-ip -> cell-size<0, (* cell-size 12)<270 , cell-size<180 , (* cell-size 12)<90 (defun draw_menu ( / ip-x ip-y cell-h cell-w cell-ul cell-ll cell-ur cell-lr y-list ctr-x app-list app gr-loop tblc tbtc tbbc start-viewsize) (setq app-list (list "LC" "VT" "RlxBatch" "USB" "FX" "FIP" "LspUser1" "LspUser2" "LspUser2" "Spare" "Config" "Quit")) ;;; toolbar line color / toolbar text color / toolbar background color (setq gr-loop T tblc 7 tbtc 7 tbbc 8) ;;; when zooming in/out it messes up back ground fill so have to compensate for that (setq start-viewsize (getvar "viewsize")) (redraw_menu) ;;; launch app (if app (RlxGrMenu_Start_App app)) ) (defun redraw_menu () (redraw) ;;; get live screen data (count_calcula) (setq cell-h (/ (- y+ y-) 12) cell-w (* cell-h 2)) ;;; corner points (setq cell-ul (list (- x+ cell-w) y+) cell-ur (list x+ y+) cell-ll (list (- x+ cell-w) y-) cell-lr (list x+ y-)) ;;; get y values for all horizontal separators (setq x-list (list (car cell-ll) (car cell-lr)) y-list (gnl- (- (fix y+) cell-h) 11 cell-h)) ;;; fill the backgrounds (setq yy y-) (while (< yy y+) (grdraw (list (car cell-ll) yy) (list (car cell-lr) yy) tbbc) ;;; next y depends on zoom factor (viewsize) , 0.25 is emperical, bigger means bigger linespacing (setq yy (+ yy (* 0.25 (/ (getvar "viewsize") start-viewsize)))) ) ;;; draw the outlines (grdraw cell-ll cell-ul tblc)(grdraw cell-ul cell-ur tblc)(grdraw cell-ur cell-lr tblc)(grdraw cell-lr cell-ll tblc) ;;; drawn separators (foreach y y-list (grdraw (list (car cell-ll) y) (list (car cell-lr) y) tblc)) ;;; label the cell (setq ctr-x (+ (car cell-ll) (* cell-w 0.5))) (mapcar '(lambda (s y)(grtxt (strcase s) (list ctr-x (+ y (* cell-h 0.5))) tbtc 0 "M")) app-list (append y-list (list (- (last y-list) cell-h)))) (if gr-loop (RlxGrMenu_Get_Cell_ID x-list y-list)) ) ;;; fill cell with cell background color , use offset of 0.5 unit so outlines remain visible (defun fill_cell (x y w h / x2 y2 w2 h2 x3) (setq x2 (+ x 0.5) y2 (+ y 0.5) w2 (- w 1) h2 (- h 1) x3 (+ x2 w2)) ;(repeat (* (fix h2) 2) (grdraw (list x2 y2) (list x3 y2) tbbc)(setq y2 (+ y2 0.5))) (while (< y2 (cadr cell-ul)) (grdraw (list x2 y2) (list x3 y2) tbbc)(setq y2 (+ y2 0.5))) ) ;;; (re) calculate display parameters (count_calcula) (defun count_calcula () (setq vc (getvar "VIEWCTR") vs (getvar "VIEWSIZE") ss (getvar "SCREENSIZE") dx (* vs (/ (car ss) (cadr ss)) 0.5) dy (* vs 0.5) x- (- (car vc) dx) y- (- (cadr vc) dy) x+ (+ (car vc) dx) y+ (+ (cadr vc) dy) ip (getvar "viewctr") vc-x (car ip) vc-y (cadr ip) txt-h (/ (getvar "VIEWSIZE") 100.0))) ;;; (getvar "extmin") (getvar "extmax") (setq dvx (- x+ x-) dvy (- y+ y-)) (defun screen_res (/ s i is) (setq s (vlax-invoke (vlax-create-object "WbemScripting.SWbemLocator") 'ConnectServer nil nil nil nil nil nil nil) is (vlax-invoke s 'ExecQuery "SELECT CurrentHorizontalResolution, CurrentVerticalResolution FROM Win32_VideoController")) (vlax-for i is (vlax-get i 'CurrentHorizontalResolution))) ;;; generate number (gnum 1 5) -> '(1 2 3 4 5) (defun gnum (s e / i l) (and (numberp s)(numberp e)(setq i s)(while (<= i e)(setq l (cons i l) i (1+ i)))) (reverse l)) ;;; i = startnumber n = number of numbers , d = difference (gnl- 100 6 12) -> (100 88 76 64 52 40) (defun gnl- (i n d / l) (setq l (list i))(repeat (1- n)(setq l (cons (setq i (- i d)) l)))(reverse l)) ;;; found this old lisp (grtxt.lsp) , don't know author but all credits are for this human from earth ;;; text string / coordinate point / color / angle justificationz ;;; *** UPPER CASE ONLY *** (grtxt (STRCASE "Rob") (getvar "viewctr") 1 0 "M") (defun grtxt (ts cp cl a j / vp ltb i xp z c p1 p2 lp ld n al) ;;; vertex points (setq vp '(( 1 ( 0.50 0.25))( 2 ( 0.50 0.55))( 3 ( 0.50 0.85))( 4 ( 0.50 1.00))( 5 ( 0.25 1.00)) ( 6 ( 0.00 1.00))( 7 (-0.25 1.00))( 8 (-0.50 1.00))( 9 (-0.50 0.85))(10 (-0.50 0.55)) (11 (-0.50 0.25))(12 (-0.50 0.10))(13 (-0.25 0.10))(14 ( 0.00 0.10))(15 ( 0.25 0.10)) (16 ( 0.50 0.10))(17 ( 0.50 -0.05))(18 ( 0.50 -0.45))(19 ( 0.50 -0.85))(20 ( 0.50 -1.00)) (21 ( 0.25 -1.00))(22 ( 0.00 -1.00))(23 (-0.25 -1.00))(24 (-0.50 -1.00))(25 (-0.50 -0.85)) (26 (-0.50 -0.40))(27 (-0.50 -0.05))(30 ( 0.35 0.85))(31 (-0.35 0.85))(32 (-0.35 -0.85)) (33 ( 0.35 -0.85))(40 ( 0.25 0.35))(41 (-0.25 0.35))(42 ( 0.25 -0.15))(43 (-0.25 -0.15)) (44 ( 0.00 0.45))(45 ( 0.00 -0.25))(50 ( 0.30 0.20))(51 ( 0.30 0.35))(52 ( 0.20 0.35)) (53 ( 0.20 0.20))(54 ( 0.30 0.10))(55 ( 0.30 -0.10))(56 ( 0.20 -0.10))(57 ( 0.20 0.10)) (60 (-0.30 0.20))(61 (-0.30 0.35))(62 (-0.20 0.35))(63 (-0.20 0.20))(64 (-0.30 0.10)) (65 (-0.30 -0.10))(66 (-0.20 -0.10))(67 (-0.20 0.10)))) ;;; letter table (setq ltb '(("A" 24 9 7 5 3 20 16 12) ("B" 12 15 1 3 5 8 24 21 19 17 15) ("C" 3 5 7 9 25 23 21 19) ("D" 3 5 8 24 21 19 3) ("E" 4 8 12 15 12 24 20) ("F" 4 8 12 15 12 24) ("G" 3 5 7 9 25 23 21 19 16 14) ("H" 20 -4 8 -24 16 12) ("I" 7 5 6 22 23 21) ("J" 4 19 21 23 25) ("K" 8 24 12 13 4 13 20) ("L" 8 24 20) ("M" 24 8 14 4 20) ("N" 24 8 20 4) ("O" 3 5 7 9 25 23 21 19 3) ("P" 12 15 1 3 5 8 24) ("Q" 3 5 7 9 25 23 21 19 3 -19 20 45) ("R" 20 14 12 15 1 3 5 8 24) ("S" 3 5 7 9 11 13 15 17 19 21 23 25) ("T" 4 8 6 22) ("U" 8 25 23 21 19 4 20) ("V" 8 22 4) ("W" 8 23 14 21 4) ("X" 4 -24 8 20) ("Y" 8 14 22 14 4) ("Z" 8 4 24 20) ("0" 3 5 7 9 25 23 21 19 -3 4 24) ("1" 31 7 6 22 21 23) ("2" 9 7 5 3 1 15 13 27 24 20) ("3" 9 7 5 3 1 15 13 15 17 19 21 23 25) ("4" 8 12 16 15 5 21) ("5" 4 8 12 15 17 19 21 23 25) ("6" 3 5 7 9 25 23 21 19 17 15 12) ("7" 8 4 22) ("8" 3 5 7 9 11 13 27 25 23 21 19 17 15 13 15 1 3) ("9" 25 23 21 19 3 5 7 9 11 13 16) ("<" 4 12 20) (">" 8 16 24) ("," 33 21) ("." 19 20 21 33 19) ("\'" 4 30) ("\"" 4 -30 7 31) (";" 50 51 52 53 -50 54 55 56 57 55 45) (":" 50 51 52 53 -50 54 55 56 57 55) ("\\" 8 20) ("/" 4 24) ("?" 11 10 7 5 2 1 45 22) ("|" 6 -44 45 22) ("+" 44 -45 13 15) ("=" 40 -41 43 42) ("-" 13 15) ("_" 20 24) (")" 6 2 18 22) ("(" 6 10 26 22) ("*" 40 -43 41 -42 45 44) ("&" 21 31 7 6 26 25 23 16) ("^" 10 6 2) ("%" 57 54 55 56 -57 63 60 61 62 -63 5 24) ("$" 3 5 7 9 11 13 15 17 19 21 23 25 -26 22 6) ("#" 24 -6 22 -4 1 -11 17 27) ("@" 42 15 40 44 41 13 43 45 42 17 3 5 7 9 25 23 21 19) ("!" 6 -45 22 22) ("~" 9 31 44 40 2) ("`" 8 31) ("[" 6 8 24 22) ("]" 6 4 20 22) ("{" 6 7 41 12 43 23 22) ("}" 6 5 40 16 42 21 22) (""))) ;;; text height (setq z (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")) 0.2)) (cond ;;; left justification ((eq (strcase (substr j 1 1)) "L") (setq xp (list (+ (car cp) z) (cadr cp)) i 1)) ;;; middle justification ((eq (strcase (substr j 1 1)) "M") (setq xp (list (- (car cp) (* z (strlen ts) 0.5)) (cadr cp)) i 1)) ;;; right justification ((eq (strcase (substr j 1 1)) "R") (setq xp (list (- (car cp) (* z (strlen ts) 1.5)) (cadr cp)) i 1)) ) (repeat (strlen ts) ;;; each charachter / line point list / letter point def (setq c (substr ts i 1) lp '() ld (cdr (assoc c ltb))) (while (> (length ld) 1) (setq p1 (cadr (assoc (abs (nth 0 ld)) vp)) p2 (cadr (assoc (abs (nth 1 ld)) vp)) p1 (mapcar '* (list z z) p1) p2 (mapcar '* (list z z) p2) p1 (mapcar '+ xp p1) p2 (mapcar '+ xp p2) lp (append lp (list (if (minusp (nth 0 ld)) 0 cl) p1 p2)) ld (cdr ld)) ) ;;; add rotation angle (setq n 0 al nil) (repeat (/ (length lp) 3) (setq al (cons (nth n lp) al) al (cons (polar cp (+ a (angle cp (nth (+ n 1) lp))) (distance cp (nth (+ n 1) lp))) al) al (cons (polar cp (+ a (angle cp (nth (+ n 2) lp))) (distance cp (nth (+ n 2) lp))) al)) (setq n (+ n 3)) ) (and al (grvecs (reverse al))) (setq xp (list (+ (car xp) (* z 1.5)) (cadr xp)) i (1+ i)) ) (prin1) ) ;;; probably won't need tracking mode (cut-copy-paste you know...) (defun RlxGrMenu_Get_Cell_ID (xl yl / inp dev tpt prev-tpt mark-current-tracking-point cell-id prev-cell-id prev-view-size cur-view-size rtn) (princ "\nEsc/Q/Rmouse to cancel, zoom with E(extend), Z(oom) or + / -") (setq prev-view-size (getvar "viewsize")) (while gr-loop (setq cur-view-size (getvar "viewsize")) (setq inp (vl-catch-all-apply 'grread (list T 8 1))) (if (vl-catch-all-error-p inp) (progn (setq gr-loop nil inp nil)(redraw)) (progn (setq dev (car inp) tpt (cadr inp)) (cond ;;; space , q or Q (Quit) ((and (= dev 2) (member (last inp) '(32 113 81))) (redraw)(setq gr-loop nil) ) ;;; point selection (3 (221.882 173.853 0.0)) ((= dev 3) (if (setq rtn (find_cell tpt xl yl)) (progn ;(alert (setq app (nth (1- (atoi rtn)) app-list))) (princ (strcat "\nLaunching : " (setq app (nth (1- (atoi rtn)) app-list)))) (setq gr-loop nil) ) ) ) ;;; device tracking point (probably don't need tracking mode) ((= dev 5) ;;; if mouse moved (if (or (/= (car prev-tpt)(car tpt)) (/= (cadr prev-tpt)(cadr tpt))) (progn (setq prev-tpt tpt ))) (if (not (equal cur-view-size prev-view-size)) (progn (setq prev-view-size cur-view-size) (redraw_menu) ) ) ) ; user pressed E of e ((member inp '((2 69)(2 101))) (command "zoom" "e")) ; user clicked R-mouse button, pressed enter or space (done selecting) ((or (equal (car inp) 25)(member inp '((2 13)(2 32)))) (setq gr-loop nil)) ; user pressed + ((equal inp '(2 43)) (vl-cmdf "zoom" "2x")) ; user pressed - ((equal inp '(2 45)) (vl-cmdf "zoom" ".5x")) ; user pressed z or Z ((member inp '((2 122)(2 90))) (vl-cmdf "'zoom" "")) ) ) ) ) (princ) ) ;;; pt = point , xl = x-list , yl = y-list ;;; scribble : (< 1 2 3) , (> 3 2 1) , (cdr (vl-sort '(1 2 3 4 5) '>)) -> '(4 3 2 1) (defun find_cell ( pt xl yl / ptx pty y-lst l n hit) (setq n nil hit nil ptx (car pt) pty (cadr pt) y-list (vl-sort (append yl (list 0)) '>)) (if (< (car xl) ptx (cadr xl)) (mapcar '(lambda (y)(if (and (not hit) (> pty y)) (setq hit T n (vl-position y y-list)))) y-list)) (if n (itoa (1+ n))) ) ;;; program assumes no self starting routines and start command is "C:" + app name (defun RlxGrMenu_Start_App (app / fn) (cond ((setq fn (findfile (strcat app ".lsp"))) (redraw)(load fn)(eval (read (strcat "(C:" app ")")))) ((wcmatch (strcase app) "QUIT")(princ "\nBye bye")(redraw)) ((wcmatch (strcase app) "CONFIG")(princ "\nUnder construction")(redraw)) (t (redraw)(princ (strcat "\nUnable to load " (vl-princ-to-string app) " ...bye"))) ) ) ;;; future... ;;; RlxGrMenu - Rlx Jul/25 (defun RlxGrMenu_future ( / ;;; global variables scr-res cell-rows cell-cols cell-col cell-id app-list ;;; display parameters like viewctr/viewsize/screensize (count_calcula) vc vs ss dx dy x- x+ y- y+ ip vc-x vc-y txt-h ;;; registry variables RlxGrMenu-nof-cell-rows RlxGrMenu-nof-cell-cols RlxGrMenu-app-list ) ;;; mostly not used because for now I just just one column with 10 rows (setq scr-res (screen_res) rows 3 cols 3 cell-col 141 cell-id 1) (count_calcula) (setq app-list (list "LC" "VT" "RlxBatch" "USB" "FX" "FIP" "LspUser1" "LspUser2" "LspUser2" "Spare")) (RlxGrMenu_Init) (RlxGrMenu_Doit) (RlxGrMenu_Exit) (princ) ) (defun RlxGrMenu_Init ()(princ "\nUnder construction - RlxGrMenu_Init ")) (defun RlxGrMenu_Doit ()(princ "\nUnder construction - RlxGrMenu_Doit ")) (defun RlxGrMenu_Exit ()(princ "\nUnder construction - RlxGrMenu_Exit ")) (defun c:RlxGrMenu ()(draw_menu)) (defun c:t1 ()(draw_menu)) (defun t1 ()(draw_menu))
  11. Hi @PGia - just getting back from a long weekend. Thanks for the reply, but I'm still not seeing a post that explains why you need another user's administrator privilege? To do what (remotely)? Cheers
  12. P.S.: You must make sure to accompany 'aplicAdmin' with the correct argument: the name of the process. This means that it won't always be the same as the application. For example: for AutoCAD it's 'acad', but for Paint it's 'mspaint'. Therefore, make sure you correctly identify the name of the process you want to check before writing it into your code.
  13. Maybe I'm wrong, but I don't think you can control a previously opened Access instance with AutoCAD. Does anyone know if this is actually possible? As for the code to check if any open application in Windows (controlled or not from AutoCAD) is running with Administrator privileges, another trick could be used: ask PowerShell. You should keep in mind that this code requires AutoCAD to be running as admin to work. Therefore, you may want to run 'acAdmin' first to ensure the response from 'aplicAdmin' is valid. It's not very fast, but it works. (defun aplicAdmin? (nbreAplic / arch shell ruta ruta1 f r) (if (setq arch (open (setq ruta (strcat (getenv "TEMP") "\\ea.ps1")) "w")) (progn (write-line (strcat "Add-Type @\" using System; using System.Runtime.InteropServices; public class Advapi32 { [DllImport(\"advapi32.dll\", SetLastError=true)] public static extern bool OpenProcessToken(IntPtr ProcessHandle, UInt32 DesiredAccess, ref IntPtr TokenHandle); [DllImport(\"advapi32.dll\", SetLastError=true)] public static extern bool GetTokenInformation(IntPtr TokenHandle, int TokenInformationClass, byte[] TokenInformation, int TokenInformationLength, ref int ReturnLength); } \"@ param([string]$procName = \"" nbreAplic "\") # Obtiene el proceso $proc = Get-Process -Name $procName -ErrorAction SilentlyContinue if ($proc) { # Intenta abrir el token del proceso $handle = $proc.Handle $token = [System.IntPtr]::Zero $TOKEN_QUERY = 0x0008 $TokenElevation = 20 $tokenInfo = New-Object byte[] 4 $returnLength = 0 $r1 = [Advapi32]::OpenProcessToken($handle, $TOKEN_QUERY, [ref]$token) $r2 = [Advapi32]::GetTokenInformation($token, $TokenElevation, $tokenInfo, $tokenInfo.Length, [ref]$returnLength) if ($r1 -and $r2) { $elevado = [BitConverter]::ToInt32($tokenInfo, 0) if ($elevado -eq 1) { \"SI\" | Out-file \"$env:TEMP\\esAdmin.txt\" -encoding ASCII } else { \"NO\" | Out-file \"$env:TEMP\\esAdmin.txt\" -encoding ASCII } } else { \"ERROR\" | Out-file \"$env:TEMP\\esAdmin.txt\" -encoding ASCII } } else { \"NOEXISTE\" | Out-file \"$env:TEMP\\esAdmin.txt\" -encoding ASCII } exit" ) arch ) (close arch) (setq shell (vlax-create-object "WScript.Shell")) (vlax-invoke shell 'Run (strcat "powershell.exe -ExecutionPolicy Bypass -WindowStyle Hidden -File \"" ruta "\"") 0 :vlax-true); Ejecuta PowerShell en segundo plano (vlax-release-object shell) (if (findfile (setq ruta1 (strcat (getenv "TEMP") "\\esAdmin.txt"))) (if (setq f (open ruta1 "r")) (progn (setq r (= (read-line f) "SI")) (close f) (vl-file-delete ruta) (vl-file-delete ruta1) r ) ) ) ) ) ) However, maybe someone knows a better way.
  14. Maybe this thread will help... How to copy a layout using vla object? - AutoLISP, Visual LISP & DCL - AutoCAD Forums
  15. have done a sort of messenger in the past with (m)text so just wanted to try something else. With vectors a simple redraw and your plate is clean again. I was / am considering adding background but for now wanted to keep it fast & furious due to workload (turning my boss's promises into reality)
  16. Interesting for sure!
  17. Hi, I’ve made a script that finds all plan borders (polygons/boxes) on a specific layer, grabs the text inside each one, then creates new layouts using the bounding box (LL & UR) and names them accordingly. It works fine on small files almost instantly creating the tabs/layouts, but as the file size grows, it slows down a lot — specifically around when creating layouts and switching tabs. Would switching from a Command to VLA help speed this up? id just like to optimise this as much as i possibly could Here’s the part of the script that handles layout creation: ;; Process each plan (foreach plan border-list (setq layout-name (car plan) LL (cadr plan) UR (caddr plan) layout-orientation (last plan)) ;; Create layout - can we change this to VLA? speed up the copy function? (command ".layout" "copy" layout-orientation layout-name) ;; Set active layout (setq layname (vla-Item layouts (1- (vla-get-Count layouts)))) (vla-put-ActiveLayout doc layname) ;; Set viewport (vla-put-Mspace doc :vlax-true) (vla-ZoomWindow app LL UR) (vla-put-Mspace doc :vlax-false) (setq done (1+ done)) (princ (strcat "\n" (itoa done) "/" (itoa total))) )
  18. shortkrish

    Autolisp to make holes

    (defun c:HC ( / rows cols rowd rowv rowh hole ) (setq rows (getint "\nEnter the number of rows (---) <1>: ") cols (getint "\nEnter the number of columns (|||) <1>: ") rowd (getdist (strcat "\nBeam guage <" (rtos 3) ">: ")) rowv (getdist (strcat "\nVertical center / center <" (rtos 3) ">: ")) rowh (getdist (strcat "\nHorizontal center / center <" (rtos 4) ">: ")) hole (getdist (strcat "\nHole diameter " (rtos 0.8125) ">: ")) ) (if (= rows nil)(setq rows 1)) (if (= cols nil)(setq cols 1)) (if (= rowd nil)(setq rowd 3)) (if (= rowh nil)(setq rowh 4)) (if (= rowv nil)(setq rowv 3)) (if (= hole nil)(setq hole 0.8125)) (setq ins (getpoint "\nSelect insertion point: ")) (if (> cols 1)(setq ins (polar ins pi (/ (* (1- cols) rowh) 2.0)))) (repeat cols (setq lstpnt (polar ins (* pi 1.5) rowd)) (entmake (list (cons 0 "circle")(cons 10 lstpnt)(cons 40 (/ hole 2.0)))) (repeat (1- rows) (setq lstpnt (polar lstpnt (* pi 1.5) rowv)) (entmake (list (cons 0 "circle")(cons 10 lstpnt)(cons 40 (/ hole 2.0)))) ) (setq ins (polar ins 0 rowh)) ) (princ) ) (defun c:HE ( / dir rows rowd rowh rowv rowo hole ) (initget 0 "Left Right") (setq dir (getkword "\nEnd of beam (Left/Right) <L>: ") rows (getint "\nEnter the number of rows (---) <1>: ") rowd (getdist (strcat "\nBeam guage <" (rtos 3) ">: ")) rowv (getdist (strcat "\nVertical center / center <" (rtos 3) ">: ")) rowo (getdist (strcat "\nEndge offset <" (rtos 1.5) ">: ")) hole (getdist (strcat "\nHole diameter " (rtos 0.8125) ">: ")) ) (if (= dir nil)(setq dir "Left")) (if (= rows nil)(setq rows 1)) (if (= rowd nil)(setq rowd 3)) (if (= rowh nil)(setq rowh 4)) (if (= rowv nil)(setq rowv 3)) (if (= rowo nil)(setq rowo 1.5)) (if (= hole nil)(setq hole 0.8125)) (setq ins (getpoint "\nSelect insertion point: ")) (if (= dir "Left") (progn (setq ins (polar ins 0 rowo) lstpnt (polar ins (* pi 1.5) rowd) ) (entmake (list (cons 0 "circle")(cons 10 lstpnt)(cons 40 (/ hole 2.0)))) (repeat (1- rows) (setq lstpnt (polar lstpnt (* pi 1.5) rowv)) (entmake (list (cons 0 "circle")(cons 10 lstpnt)(cons 40 (/ hole 2.0)))) ) ) (progn (setq ins (polar ins pi rowo) lstpnt (polar ins (* pi 1.5) rowd) ) (entmake (list (cons 0 "circle")(cons 10 lstpnt)(cons 40 (/ hole 2.0)))) (repeat (1- rows) (setq lstpnt (polar lstpnt (* pi 1.5) rowv)) (entmake (list (cons 0 "circle")(cons 10 lstpnt)(cons 40 (/ hole 2.0)))) ) ) ) (princ) ) Dear All, I just need one more favour of the same holes.lsp to have place in in angle for bracings. When I put ucs to objects place it angle, the holes going to 0,0 Please find attached lisp from this forum and resultant in image attached. Thanks Krishna
  19. Nice, I can see uses for this. Might add a slight change one day if it works to draw a wipeout under the 'buttons'?
  20. Have you considered replacing grvecs with temporary 'TEXT' objects? It's easier to do this with dynamically sized and positioned text. This makes it easier to create effects such as mouse-over highlighting. @mhupp "It's never too late to return to the old places where you loved life"
  21. Oh , you're not lisping anymore? pitty... you belong to the top lispy's
  22. BIGAL

    Gap Dcl in Block list

    You can delete the wrong code in above post and resave. Go to the post and Click on the ... on right allows you to edit.
  23. Last week
  24. Wish i still had cad to test this out.
  25. to be honest, the grtext part its something I found a long time ago (grtxt.lsp , but can't find the site it came from anymore , nor does it have information about the author) It's not as good as Lee's grtext (this one only does uppercase) but it's simpler and gets the job done.
  26. Amazing and original. I find it interesting to see how you’ve solved the character's drawing using polar coordinates. I also did something similar when I was thinking about drawing text next to the cursor in real time. I even created tools to encode characters from drawing polylines. But I gave up on the idea because there are simpler options. However, your approach is a different one — something I had never considered. It’s an interesting idea that opens the door to imagining new possibilities
  27. Lee Mac

    Gap Dcl in Block list

    Hint: (add_list (strcat "\t" (car x) "\t" (cadr x)))
  28. I think this thread is becoming interesting again. I suppose there will be some updates in the near future — I believe @Dexus has opened the door to some much-needed improvements. As for me, I take up the gauntlet. But I believe the basic rule should be not to rely on third-party libraries/APIs (except those inherent to Windows and AutoCAD).
  29. The biggest advantage to LISP solution is usability, very few people are allowed to load programs on their work computers, but most can download and run a LISP. @GLAVCVS latest works fine for me as of now. Right now I'm just getting a few things done for after I retire to help those behind me do things easier. I might just do a whole new take on a solution to this issue and have the user input the new diameters/radii, lengths, etc. and redraw it.
  1. Load more activity
×
×
  • Create New...