Jump to content

All Activity

This stream auto-updates

  1. Past hour
  2. mhupp

    tables

    Do you want step by step undo? I would just wrap it in the start and end of the lisp to have one undo. (defun c:foo () (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-StartUndoMark doc) ; Begin Undo Group ;code (vla-EndUndoMark doc) ;End Undo Group (princ) )
  3. Today
  4. Yes, it could use some more refinement, but plenty close for what I need right now, I would like to get this LISP working on Leaders as well. I did get some headway on drawing a multileader to length, but spent too much time on this already, I have a couple of quick projects at work to knock out, so probably get back to it next week. I also looked at exploding, didn't really seem to be much better. When time allows I will play some more.
  5. maahee

    tables

    (command "_.undo" "_begin") (setq dbase '()) ; Initialize dbase as empty list (setq selected-ent '()) (while (setq obj (ssget "_:S")) (setq ent (ssname obj 0)) (setq db (entget ent)) (setq tp (cdr (assoc 0 db))) ; Get entity type (if (or (= tp "LINE") (= tp "LWPOLYLINE")) (progn (if (not (member ent selected-ent)) (progn (setq selected-ent (cons ent selected-ent)) (cond ((= tp "LINE") (command "_.undo" "_begin") (setq p1 (cdr (assoc 10 db))) ; Start point coordinates (setq p2 (cdr (assoc 11 db))) ; End point coordinates (setq dist (distance p1 p2)); Calculate distance between p1 and p2 (setq dbase (cons (list dist) dbase)) (command "_.undo" "_end") ) ;cond1 ((= tp "LWPOLYLINE") (princ "\nPolyline selected. Midpoint calculation not implemented for polylines." ) ) ;cond2 ) ;cond main ) ;progn (princ "\nEntity already selected please select a different entity" ) ) ;if ) ;progn (princ "\nSelected entity is not a line or polyline.") ) ;if ) ;while (command "_.undo" "_end") ;;;;;;;;;;;; undo function used for undoing a single line or a polyline within the while function, and undoing a group of lines and polylines at the end of the while function.... active existed while loop by undo
  6. interesting I only used VBA to call a single command at a time from excel. Test if your in blockeditor (getvar 'BLOCKEDITOR)
  7. Yesterday
  8. You're an angel. Works in LT now we have lisp functionality.
  9. Here's the program I have now. It requires the RunAll Utility found here: https://www.theswamp.org/index.php?topic=53912 ;; ;; ToggleDisplayColour.lsp ;; ;; Author: 3dwannab + others ;; ;; Version History: ;; v1.0 - 2024-06-11: Initial version. Updated to change the grid colours depending on if the background is black or white. ;; v1.1 - 2025.06.16: Updated to change the grid colours depending on if the background is black or white. ;; v1.2 - 2025.09.04: Updated to set the plot styles display on all open documents with the help of RunAll Utility found here: https://www.theswamp.org/index.php?topic=53912 ;; ;; What this does: ;; - Toggles the AutoCAD background colour between black and white in the current space (model or layout). ;; - If the background is white the plot styles display, if black they don't. ;; - Updates grid colours to suit the background and toggles plot style display. ;; - No effect on the block editor. Refreshes DWG to display correctly. ;; ;; NOTES: ;; - Toggling doesn't work when running the command inside the block editor. Not much I think I can do about ;; apart from perhaps implementing this https://forums.autodesk.com/t5/net-forum/change-the-block-editor-background-color-at-runtime/td-p/9831561. ;; ;; TO DO: ;; – NA ;; (vl-load-com) ;; Converts RGB values to AutoCAD decimal color value (defun rgb-to-dec (r g b) (+ r (* g 256) (* b 65536)) ) ;; Helper to extract RGB from decimal color (defun dec-to-rgb (dec / r g b) (setq r (rem dec 256)) (setq g (rem (/ dec 256) 256)) (setq b (rem (/ dec 65536) 256)) (list r g b) ) ;; Helper to compute brightness (perceived luminance) (defun color-brightness (dec / rgb) (setq rgb (dec-to-rgb dec)) (+ (* 0.299 (float (car rgb))) (* 0.587 (float (cadr rgb))) (* 0.114 (float (caddr rgb))) ) ) ;------------------------------------------------------- ; rm:displayplotstyles ; 04/03/10 ruul at ctr.co.at ; nomen est omen - toggles display of plot styles... ;------------------------------------------------------- ; Updated 110208 by Mike Sweeney ; (defun rm:displayplotstyles (bshow ball / acdoc bvshow layout layouts) (princ "\nDisplay plot styles ") (vl-load-com) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq layouts (vla-get-layouts acdoc)) (setq bvshow (if bshow :vlax-true :vlax-false)) (princ (if bshow "ON" "OFF")) (cond (ball (vlax-for layout layouts (if (/= (vla-get-name layout) "Model") (vla-put-ShowPlotStyles layout bvshow) ) ) (princ " in all layouts\n") ) (T (setq layout (vla-get-ActiveLayout acdoc)) (vla-put-ShowPlotStyles layout bvshow) (princ " in current layout\n") ) ) (vla-regen acdoc acactiveviewport) (princ) ) ;; Returns T if the background is white (defun isWhiteBackground (/ bgColorDark bkColorLight cur inBlockEditor pref previousColLight previousColor tilemde) ;; Assign cur depending on tilemode (setq pref (vla-get-display (vla-get-Preferences (vlax-get-acad-object)))) (setq tilemde (getvar "tilemode")) (if (= tilemde 1) (setq cur (vla-get-GraphicsWinModelBackgrndColor pref)) (setq cur (vla-get-GraphicsWinLayoutBackgrndColor pref)) ) ;; Set up the dark and light colours to toggle (setq bgColorDark (rgb-to-dec 0 0 0)) (setq bkColorLight (rgb-to-dec 255 255 255)) (setq previousColLight bkColorLight) ; for compatibility with existing code ;; Get current background color (setq inBlockEditor (= (getvar "BLOCKEDITOR") 1)) (if inBlockEditor (setq previousColor (atoi (getenv "BEditBackground"))) (setq previousColor (vlax-variant-value (vlax-variant-change-type cur vlax-vblong))) ) ;; Decide if we need to switch to light or dark based on current colour (cond ((= previousColor bgColorDark) T) ; If currently dark, switch to light ((= previousColor bkColorLight) nil) ; If currently light, switch to dark (T ; Fallback: use brightness as before (> (color-brightness previousColor) (/ (+ (color-brightness bgColorDark) (color-brightness bkColorLight)) 2.0) ) ) ) ) ;; Toggles the display from black to white ;; If black the plot styles are not shown ;; If white the plot styles are shown (defun c:TG (/ bgColorDark bkColorLight doc gridcol-major gridcol-minor gridcolDarkMajor gridcolDarkMinor gridcolLightMajor gridcolLightMinor inBlockEditor pref previousColLight tilemde whiteBackground) (setq doc (vla-get-activedocument (vlax-get-acad-object))) ;; Define grid color lists (setq gridcolLightMajor (rgb-to-dec 100 200 200)) (setq gridcolLightMinor (rgb-to-dec 240 240 240)) (setq gridcolDarkMajor (rgb-to-dec 10 60 60)) (setq gridcolDarkMinor (rgb-to-dec 35 35 35)) ;; Assign cur depending on tilemode (setq pref (vla-get-display (vla-get-Preferences (vlax-get-acad-object)))) (setq tilemde (getvar "tilemode")) ;; Set up the dark and light colours to toggle (setq bgColorDark (rgb-to-dec 0 0 0)) (setq bkColorLight (rgb-to-dec 255 255 255)) ; (setq previousColLight bkColorLight) ; for compatibility with existing code ;; Get current background color (setq inBlockEditor (= (getvar "BLOCKEDITOR") 1)) (setq whiteBackground (isWhiteBackground)) ;; Set grid colors based on background (if whiteBackground ;; Was light or lighter background, so toggle to dark background (progn (setq gridcol-major gridcolLightMajor) (setq gridcol-minor gridcolLightMinor) ) ;; Was dark or darker background, so toggle to light background (progn (setq gridcol-major gridcolDarkMajor) (setq gridcol-minor gridcolDarkMinor) ) ) ;; Model space and Block Editor (if (not (zerop tilemde)) ; Model space (progn ;; Toggle background color for model space (if (not inBlockEditor) (progn (vla-put-GraphicsWinModelBackgrndColor pref (vlax-make-variant (if whiteBackground bkColorLight bgColorDark) vlax-vblong)) (setenv "2D Model grid major lines color" (itoa gridcol-major)) (setenv "2D Model grid minor lines color" (itoa gridcol-minor)) ) ) ;; Toggle Block Editor background color in registry (if inBlockEditor (progn ; (setenv "BEditBackground" (itoa (if whiteBackground bgColorDark previousColLight))) ; (setenv "BEdit grid major lines color" (itoa gridcol-major)) ; (setenv "BEdit grid minor lines color" (itoa gridcol-minor)) (alert "\nNote:\nBackground cannot be updated inside the block editor\n") ) ) ) ;; progn - Model space ;; Paper space (Layout) (progn (vla-put-GraphicsWinLayoutBackgrndColor pref (vlax-make-variant (if whiteBackground bkColorLight bgColorDark) vlax-vblong)) (setenv "Layout grid major lines color" (itoa gridcol-major)) (setenv "Layout grid minor lines color" (itoa gridcol-minor)) ) ;; progn - Paper space ) ;; Toggle plot styles in paper space (if (not inBlockEditor) (progn (if whiteBackground ;; Toggles all open docs to display correctly (_RunAll "(rm:displayplotstyles t nil)") ;; Turn on display of plot styles with external RunAll Ultity found here: https://www.theswamp.org/index.php?topic=53912 (_RunAll "(rm:displayplotstyles nil nil)") ;; Turn off display of plot styles with external RunAll Ultity found here: https://www.theswamp.org/index.php?topic=53912 ;; Old code that doesn't toggle the plot styles on all open drawings ; (rm:displayplotstyles t nil) ;; Turn on display of plot styles ; (rm:displayplotstyles nil nil) ;; Turn off display of plot styles ) ) ) (vlax-release-object pref) (princ) ) ; (c:TG) ;; Unblock for testing
  10. Why shurg? Sorry if you're MP over on there. It can pass defun if they're done like so with defun-q: (defun-q foo ( ) (command "tilemode" 1) (princ)) (vl-propagate 'foo) The running (foo) in the other open drawings will set them to model space. So this is where I was hoping that my code earlier would work.
  11. double post deleted.
  12. This thread for RunAll by MP on the swamp wrote this. @BIGAL, that RunAll utility will process all open drawings without having to write a script.
  13. I do know of this prograam that was on the swamp by MP over there. https://www.theswamp.org/index.php?topic=53912.msg586779#msg586779 Just thought that (vlax-for d (vla-get-Documents (vlax-get-acad-object)) would work for this.
  14. That's not how vl-propagate works. it only passes variable and its value between all open drawings. here is how i used it passing VC and SZ between all open drawings. once ZAD is run in one drawing any other drawing you run ZAD in will zoom to the same xy location. it was good to look at old revisions. ;;----------------------------------------------------------------------------;; ;; Zoom Area Across Multiple Drawings (defun C:ZAD (/ a) (initget "Yes No") (setq a (cond ((getkword "\nRedefine Zoom Area? [Yes/No]: ")) ("No") ) ) (if (= "Yes" a) (progn (vl-cmdf "_.Zoom" "W" Pause Pause) (setq vc (getvar 'viewctr)) (setq SZ (getvar 'viewsize)) (vl-propagate 'vc) (vl-propagate 'sz) ) (if (or (= vc nil) (= sz nil)) (prompt "\nPlease Define Zoom Area") (vl-cmdf "_.Zoom" "C" VC SZ) ) ) (princ) ) like i said AutoCAD doesn't like to run one lisp across multiple open drawings. but its been awhile since iv used it. Maybe this would work? -- edit oops didn't hit post
  15. You can get a list of currently open documents and change to any of those documents. But your lisp will stop. Not sure and have mot tested using a script with this method. The one thing you must do is re do the current document list each time you change dwg. (defun openblk (blkname / adocs) (setq acDocs (vla-get-documents (vlax-get-acad-object))) (vla-open acDocs blkname) (vla-activate (vla-item acdocs 1)) ) You could load the lisp and run for each dwg name. have a look at 1st line each item inside acdocs for dwg names. Then write a script. script maybe (load "openblk") (openblk "dwg1") ; do your thing Save Close (load "openblk") (openblk "dwg2") ; do your thing Save Close and so on Example (vlax-get (vla-item acdocs 1) 'name) = "section.dwg" the acdoc has property "Count" so know how many dwgs are open.
  16. Just a comment, If you compare the length of using vertices against the length of the spline they are different. So that was why I was exploding the mleader and playing with adjusting say the arrow point. The code I posted for 2 point mleaders could be easily changed to work with 3 or 4 vertices, ie a straight segment Mleader. That is why I was looking at making a matching spline and adjust it till correct length with doglegend = 0.0. Just have to work out how to set tangential line start to spline. A when have time task.
  17. Yup, that sounds about right... LISP generally cannot perform a function on another open drawing. In MHUPPs link Lee Mac explains it in there. The only way I've found you can do it is to make a script for example in Lee Macs Script Write or in Script Writer Pro and use that - the drawings have to be closed though
  18. Even this simple example doesn't work. ; TILEMODE_MODEL (defun-q RUNTILEMODE_MODEL () (command ".TILEMODE" "1") (princ) ) (vl-propagate 'RUNTILEMODE_MODEL) (defun c:test (/ app docs) (setq app (vlax-get-acad-object) docs (vla-get-Documents app) ) (vlax-for d docs (RUNTILEMODE_MODEL) ) (princ "\nAll drawings set to model space.") (princ) )
  19. I've tried this and it's still the same. ;; Define a safe toggle function (defun-q my-pstyle-toggle (doc state / layout) (setq layout (vla-get-ActiveLayout doc)) (vla-put-ShowPlotStyles layout (if state :vlax-true :vlax-false)) (vla-Regen doc acActiveViewport) ) ;; Make sure all drawings know about it (vl-propagate 'my-pstyle-toggle) ;; Apply it to all open documents (defun c:AllDocsPstyleOn (/ app docs) (setq app (vlax-get-acad-object) docs (vla-get-Documents app) ) (vlax-for d docs (my-pstyle-toggle d T) ;; pass :vlax-true ) (princ "\nPlot styles ON for all open drawings.") (princ) ) (defun c:AllDocsPstyleOff (/ app docs) (setq app (vlax-get-acad-object) docs (vla-get-Documents app) ) (vlax-for d docs (my-pstyle-toggle d nil) ;; pass :vlax-false ) (princ "\nPlot styles OFF for all open drawings.") (princ) ) @Steven P, it's switching drawings alright. Just not toggling the plotstyles.
  20. thanks in advance for any help
  21. Hello everyone, I'm currently working on a project to design a shooting range and am exploring how to integrate firing range software with AutoCAD. Specifically, I'm interested in software that can assist in layout planning, safety zone analysis, and compliance with regulatory standards. Has anyone here utilized firing range software in conjunction with AutoCAD? If so, could you share your experiences, challenges faced, and any recommendations for compatible tools or workflows? Additionally, are there specific AutoCAD features or plugins that can enhance the design and simulation of shooting ranges? Looking forward to your insights.
  22. I had most of it deciphered, but thanks that's much better than I ended up with. I may yet have use for it.
  23. So I have this working so far, not super accurate on multipoint Spline Multileaders, but close enough, seems accurate on some tested 2 point Multileaders. Changing the multipoint Multileaders to Straight Multileaders then running the LISP, then converting back to Spline Multileaders seems more accurate. Only quickly tested, so I'll know more later today if any problems arise. If interested it can be tested on the drawing I posted earlier. ;;; Match selected Multileader lengths using first selection. ;;; ;;; https://www.cadtutor.net/forum/topic/98672-get-length-of-mleaderqleader-spline/#findComment-676006 ;;; ;;; By SLW210 (a.k.a. Steve Wilson) ;;; (defun c:MLMtchLgnth (/ sel firstLeader vlaFirst firstLength i ent vlaCurrent pts allPts curLanding curLength scaleFactor newPts sa prevPt pt ) (vl-load-com) ;; Select MLeaders (setq sel (ssget '((0 . "MULTILEADER")))) (if sel (progn ;; First selected leader (setq firstLeader (ssname sel 0)) (setq vlaFirst (vlax-ename->vla-object firstLeader)) ;; Get points from First leader (setq pts (vlax-safearray->list (vlax-variant-value (vla-GetLeaderLineVertices vlaFirst 0) ) ) ) (setq allPts (vl-list->3dpoints pts)) ;; Measure first leader length (setq firstLength 0.0) (setq prevPt (car allPts)) (foreach pt (cdr allPts) (setq firstLength (+ firstLength (distance prevPt pt))) (setq prevPt pt) ) (princ (strcat "\nFirst leader length: " (rtos firstLength 2 2) ) ) ;; Process leaders (setq i 1) (while (< i (sslength sel)) (setq ent (ssname sel i)) (setq i (1+ i)) (setq vlaCurrent (vlax-ename->vla-object ent)) ;; Get vertices (setq pts (vlax-safearray->list (vlax-variant-value (vla-GetLeaderLineVertices vlaCurrent 0) ) ) ) (setq allPts (vl-list->3dpoints pts)) ;; Skip if less than 2 points (if (> (length allPts) 1) (progn (setq curLanding (last allPts)) ;; Measure current length (setq curLength 0.0) (setq prevPt curLanding) (foreach pt (reverse allPts) (setq curLength (+ curLength (distance prevPt pt))) (setq prevPt pt) ) ;; Compute scale factor (setq scaleFactor (/ firstLength curLength)) ;; Build new points (setq newPts '()) (foreach pt allPts (setq newPts (append newPts (list (scale-point pt curLanding)) ) ) ) ;; Flatten to doubles (setq pts (apply 'append newPts)) ;; Create and fill SafeArray (setq sa (vlax-make-safearray vlax-vbDouble (cons 0 (- (length pts) 1)) ) ) (vlax-safearray-fill sa pts) ;; Apply modified points (vla-SetLeaderLineVertices vlaCurrent 0 (vlax-make-variant sa) ) (princ (strcat "\nAdjusted leader to length " (rtos firstLength 2 2) ) ) ) (princ "\nSkipping leader with insufficient vertices.") ) ) ) (princ "\nNo MLeaders selected.") ) (princ) ) ;; Flat list to 3D points (defun vl-list->3dpoints (lst / out) (setq out nil) (while (>= (length lst) 3) (setq out (cons (list (car lst) (cadr lst) (caddr lst)) out)) (setq lst (cdddr lst)) ) (reverse out) ) ;; Scale vector from landing (defun scale-delta (landing pt) (list (* scaleFactor (- (nth 0 pt) (nth 0 landing))) (* scaleFactor (- (nth 1 pt) (nth 1 landing))) (* scaleFactor (- (nth 2 pt) (nth 2 landing))) ) ) ;; Scale point (defun scale-point (pt landing) (if (and (listp pt) (= (length pt) 3)) (mapcar '+ landing (scale-delta landing pt)) pt ) ) I wasted too much time on this, so drawing Multileaders to exact lengths will have to wait.
  24. I have more than 2 points most of the time. I'm wanting to fix already drawn leaders by matching the size and draw leaders to a specific length. Yes, I did some looking yesterday and from what I could find AutoCAD doesn't have the information exposed to API to get an exact length with more than 2 points.
  25. I have some test code and it adjusts a spline can move start or end as a choice. In the ML it uses 2 points so there is no drama in making a Mleader with a correct length as its just a case of moving arrow along the angle of the leader line. So just reset p2 to be correct length. This will draw a 2pt leader. (defun c:wow1 ( / ) (setq p1 (getpoint "\nPick 1st point ") p2 (getpoint p1 "\n insertion point >> ") ) (setq ang (angle p1 p2)) (setq d1 (rtos (distance p1 p2) 2 3)) (setq str (strcat "\n existing is " d1 " Enter new length ")) (setq d2 (getreal str)) (setq p2 (polar p1 ang d2)) (command "Mleader" p1 p2 (getstring "\nEnter text ")) (setq ent (vlax-ename->vla-object (entlast))) (vla-put-DoglegLength ent 0.0) (princ) ) (c:wow1) Note the mleader style must be set to 2 points. For the spline type answer I used 4 points max in the mleader style, I thought that was what you wanted. A 3 -4 curved leader of a known length.
  26. Last week
  27. Thanks @mhupp, I'll try that once I finish work tomorrow. @Steven P, when I replaced the vla-put-ShowPlotStyles with just a (princ "test') I think it only done the current doc. Will test tomorrow.
  28. AutoCAD doesn't like multiple drawings. you will either have to do scripts or maybe vl-propagate ?
  1. Load more activity
×
×
  • Create New...