All Activity

Is there a way to extend a horizonal line or lines to the nearest vertical line? Basically here is my scenario in the image below. You start the lisp, click at the Green point 1 then click at the green point 2. The lisp then adds 2" to the length at pt2 then drops 4" then returns the length. This part I can code using polar and the angles / lengths to draw the pline. The part I dont know is how can I extend the pline at pt1 (in green) and the end of the pline to the closest vertical red line so it looks like the image below? The distance between pt1 (in green) and the vertical red line is an unknown variable distance. Any thoughts to help me out would be great, thanks,

@dexus Well done! This works very well! Just a suggestion if you wish to add more to it. My code below is for incorporating Function keys during a grread loop would be a good addition. It doesn't support everything, like Snap, polar tracking, osnap tracking, but it does all the toggle modes. It can replace the return condition in your grread loop. ;|============================================================================== Function Name: (pjk-Grread-Fkeys <Character Code)) Arguments: kcode = integer; The Character code from the second element in the return from GRREAD. Returns: T if ENTER or SPACEBAR is pressed, otherwise NIL Description: This function emulates the functions performed when a function key is selected within a GRREAD loop. Created by Phil Kenewell 2018 ================================================================================|; (defun pjk-Grread-Fkeys (kcode / acv ret) (setq acv (atof (substr (getvar "acadver") 1 4))) (cond ((= kcode 6) ;; F3 ;; Faster more efficient way to toggle osmode. Thanks to Lee Mac for the idea. (princ (strcat "\n<Osnap " (if (>= (setvar "osmode" (boole 6 (getvar "osmode") 16384)) 16384) "off>" "on>") ) ) ) ((= kcode 25) ;; F4 (if (>= acv 18.1) ;; If AutoCAD 2011 or Higher (princ (strcat "\n<3DOsnap " (if (= (logand (setvar "3dosmode" (boole 6 (getvar "3dosmode") 1)) 1) 1) "off>" "on>") ) ) (princ (strcat "\n<Tablet " (if (= (setvar "tabmode" (- 1 (getvar "tabmode"))) 1) "on>" "off>") ) ) ) ) ((= kcode 5) ;; F5 (cond ((= (getvar "SNAPISOPAIR") 0)(setvar "SNAPISOPAIR" 1)(princ "\n<Isoplane Top>")) ((= (getvar "SNAPISOPAIR") 1)(setvar "SNAPISOPAIR" 2)(princ "\n<Isoplane Right>")) ((= (getvar "SNAPISOPAIR") 2)(setvar "SNAPISOPAIR" 0)(princ "\n<Isoplane Left>")) ) ) ((= kcode 4) ;; F6 (if (>= acv 17.0) ;; If AutoCAD 2007 or Higher (princ (strcat "\n<Dynamic UCS " (if (= (setvar "ucsdetect" (- 1 (getvar "ucsdetect"))) 1) "on>" "off>") ) ) (princ (strcat "\n<Coords " (if (= (setvar "coords" (if (= (getvar "coords") 2) 0 2)) 2) "on>" "off>") ) ) ) ) ((= kcode 7) ;; F7 (princ (strcat "\n<Grid " (if (= (setvar "gridmode" (- 1 (getvar "gridmode"))) 1) "on>" "off>") ) ) ) ((= kcode 15) ;; F8 (princ (strcat "\n<Ortho " (if (= (setvar "orthomode" (- 1 (getvar "orthomode"))) 1) "on>" "off>") ) ) ) ((= kcode 2) ;; F9 (princ (strcat "\n<Snap " (if (= (setvar "snapmode" (- 1 (getvar "snapmode"))) 1) "on>" "off>") ) ) ) ((= kcode 21) ;; F10 (princ (strcat "\n<Polar " (if (= (logand (setvar "autosnap" (boole 6 (getvar "autosnap") 8)) 8) 8) "on>" "off>") ) ) (Princ "\nNOTE: Polar Tracking is not supported in this command.") ) ((= kcode 151) ;; F11 (princ (strcat "\n<Object Snap Tracking " (if (= (logand (setvar "autosnap" (boole 6 (getvar "autosnap") 16)) 16) 16) "on>" "off>") ) ) (Princ "\nNOTE: Object Snap Tracking is not supported in this command.") ) ((= kcode 31) ;; F12 (if (>= acv 16.2) ;; If AutoCAD 2006 or Higher (princ (strcat "\n<Dynamic Input " (if (minusp (setvar "dynmode" (- (getvar "dynmode")))) "off>" "on>") ) ) ) ) ((vl-position kcode '(13 32)) ;; Enter or Spacebar (setq ret T) ) ) ret ) ;; End Function (pjk-Grread-Fkeys)

I managed to get rid of the flickering but keeping snap enabled. Here is the new version: offset.lsp Instead of hiding the polyline before doing the osnap, I now keep the polyline hidden and render it with grvecs instead. Therefore no snapping to itself and no more flickering!

@BIGAL lemme try another, I don't get the same error and have never seen that dialog myself. Thanks for looking. Drawing2.dwg

Ow sorry , not intentionally , assumend peoples would click on swamp link and see that this came from BlackBox BlackBox BlackBox

Ha! You quoted everyone but me.

RadicalPurge | AutoCAD | Autodesk App Store

You can try with Drawing Purge from autodesk app store, it's free.

I made up this one or 2 upgrades ago: (defun c:setupworkspace ( / MyWorkspace ) ;;Get workspace name to edit menubars later (setq MyWorkspace (getvar "wscurrent") ) ;;close ribbon (command "ribbonclose") ;;Show menubars / toolbar (setvar 'menubar 1) ;;menus (command "-toolbar" "draw" "s") (command "-toolbar" "draw order" "s") (command "-toolbar" "layers" "s") (command "-toolbar" "modify" "s") (command "-toolbar" "standard" "s") (command "-toolbar" "styles" "s") (command "-toolbar" "properties" "s") (command "properties") ;;ViewCube (command "DISPLAYVIEWCUBEIN2D" "Off") (command "DISPLAYVIEWCUBEIN3D" "On") ;;modelspace paper colour, RGB "255 255 255" = white "0 0 0" = black (defun somefunc (x y z) (apply '+ (mapcar 'lsh (list x y z) '(16 8 0))) ) (setenv "Background" (itoa (somefunc 255 255 255))) ;;Go to model space (setvar "ctab" (nth 0 (layoutlist) )) (setvar "ctab" "Model" ) ;;custom alerts to set up user things like papaer sizes (alert "Set up Ax Full Bleed to 0mm margins") (alert "Set up Ax Expand to 0mm margins") (alert "Set up 'DWG to PDF - No Preview.pc3'\nChange PDF Options") (alert "SP: See plotter configuration files folder, copy to AutoCAD folder") )

it is possible create a block strucutre palette in autocad 2025, like ares cad (see attached photo)? I don't know how to program and I kindly ask you who are very experienced. thanks

thanks in advance for any help

Hi all, I’m currently researching software management systems for use in a mid-sized organization and would love some input. I’m particularly interested in platforms that offer strong version control, user access management, integration capabilities, and solid reporting features. Ideally, the system should be scalable and cloud-friendly, with support for remote teams. I've come across a few options, but I’m not sure which ones offer the best balance of usability and features. Has anyone here implemented a solution they’re happy with? What would you recommend or avoid? Would love to hear about your experiences and suggestions.

everytime i jump on a new copy of cad or im helping someone out its always ribbonclose + menubar 1. still dont know why autocad continues to have the menubar off as default. it always confuses people

Your dwg on opening gave an error. Maybe that is the problem.

you could try loading the visual lisp functions in your script (never tested it myself thou..) http://www.theswamp.org/index.php?topic=57471.msg609440#msg609440 Quote from: VovKa on March 29, 2022, 11:45:12 AM Quote from: jmcshane on March 29, 2022, 09:03:29 AM I'm thinking it might be based on ActiveX which isn't supported in acoreconsole as far as I know. (layoutlist) is defined inside acapp.arx which is not loaded by acoreconsole So simply load it in the Script: Code: [Select] _.arx L "acapp.arx" (setq foo (layoutlist)) Core Console supports loading ARX/.NET assemblies.

Thanks for all the help

Thank you . I have set things running on another pc, I was hoping to save some time . interesting to learn about core console though .

The other thing that's great for Architectural Units is to remap the NumLock key to type the single quote ( ' ), then you can do all your input from the 10-key pad

Core console doesn't generally like VLA- commands, if you can do it all in pure LISP then you have more success.

Core Console returns nil for (vlax-get-acad-object).

i have a routine that cleans up drawings (dpsr), it runs great when included in a script. trying to use it with core console i get:- the lisp code for dpsr is :- ;;////////////////////////////////////////////////// ;; checkcolor (defun CheckEntColor (ent / entData color layer layerData layerColor) (setq entData (entget ent)) (setq color (cdr (assoc 62 entData))) (cond ((and color (/= color 256) (>= color 5)) T) ((or (not color) (= color 256)) (setq layer (cdr (assoc 8 entData))) (setq layerData (tblsearch "LAYER" layer)) (setq layerColor (cdr (assoc 62 layerData))) (if (and layerColor (>= layerColor 5)) T nil)) (T nil) ) ) (defun c:dpsr (/ doc ms result layers-ok ltypes-ok ents-ok props-ok layer-errors ltype-errors enttype-errors prop-errors csv-line ename clr lt lyr ) (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (setq ms (vla-get-modelspace doc)) (setq *audit-csv-path* (strcat (getvar "DWGPREFIX") "DWG_Audit_Report.csv")) ;; CSV functions (defun append2csv (line / file) (setq file (open *audit-csv-path* "a")) (if file (progn (write-line line file) (close file)) (prompt "\nERROR: Cannot write to audit CSV.") ) ) (defun writecsvheader () (if (not (findfile *audit-csv-path*)) (append2csv "DWGNAME,LAYERSTATES,LINETYPES,ENTITYTYPES,ENTITYDEF,LAYER-ERRS,LT-ERRS,TYPE-ERRS,PROP-ERRS" ) ) ) ;;//////////////////////////////////////////////////////// ;; Create or set a layer (defun makelayer (name color lw tran ltype) (if (not (tblsearch "layer" name)) (vla-add (vla-get-layers doc) name) ) (vla-put-color (vla-item (vla-get-layers doc) name) color) (vla-put-lineweight (vla-item (vla-get-layers doc) name) lw) (command "-layer" "tr" (rtos tran 2 0) name "") (command "-layer" "l" ltype name "") ) ;; Explode blocks ;;(vlax-for ent ms ;; (if (and (= "AcDbBlockReference" (vla-get-objectname ent)) ;; (vlax-method-applicable-p ent 'explode) ;;) ;;(vla-explode ent) ;;) ;;) (defun explodeall ( / explode layouts ) (setq layouts (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) explode t ) (while explode (setq explode nil) (vlax-for layout layouts (vlax-for obj (vla-get-block layout) (and (= "AcDbBlockReference" (vla-get-objectname obj)) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-explode (list obj)))) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list obj)))) (setq explode t) ) ) ) ) ;(princ) ) (explodeall) ;; Create layers (makelayer "D-3D-SOL" 7 30 0 "Continuous") (makelayer "D-3D-CLG" 1 18 0 "Center") (makelayer "D-3D-CLM" 5 18 0 "Center") (makelayer "0" 7 -1 0 "Continuous") ;; catch all to make sure everything is set ok if not created by makelayer fuction ;; Set current layer to sol (command "_.layer" "_set" "D-3D-SOL" "") (command "_.layer" "_c" "7" "" "") (command "_.layer" "_tr" "0" "" "") (command "_.layer" "_lw" "0.3" "" "") (command "_.layer" "_l" "Continuous" "" "") ;; Set current layer to clm (command "_.layer" "_set" "D-3D-CLM" "") (command "_.layer" "_c" "5" "" "") (command "_.layer" "_tr" "0" "" "") (command "_.layer" "_lw" "0.18" "" "") (command "_.layer" "_l" "Center" "" "") ;; Set current layer to clg (command "_.layer" "_set" "D-3D-CLG" "") (command "_.layer" "_c" "1" "" "") (command "_.layer" "_tr" "0" "" "") (command "_.layer" "_lw" "0.18" "" "") (command "_.layer" "_l" "Center" "" "") ;; Set current layer to 0 (command "_.layer" "_set" "0" "") (command "_.layer" "_c" "7" "" "") (command "_.layer" "_tr" "0" "" "") (command "_.layer" "_lw" "0.25" "" "") (command "_.layer" "_l" "Continuous" "" "") ;; Error counters (setq layer-errors 0 ltype-errors 0 enttype-errors 0 prop-errors 0 ) ;; Process objects (vlax-for ent ms (setq ename (vla-get-objectname ent) clr (vla-get-color ent) lt (vla-get-linetype ent) lyr (vla-get-layer ent) ) ;; Classification and move to appropriate layer (cond ((wcmatch ename "AcDb3dSolid,AcDbSurface") (vla-put-layer ent "D-3D-SOL") ) ((and (member ename '("AcDbLine" "AcDbPolyline" "AcDbCircle" "AcDbArc")) (not (CheckEntColor (vlax-vla-object->ename ent))) ;; Was (not (CheckEntColor ent)) ) (vla-put-layer ent "D-3D-CLG") ) ((and (member ename '("AcDbLine" "AcDbPolyline" "AcDbCircle" "AcDbArc")) (CheckEntColor (vlax-vla-object->ename ent)) ) (vla-put-layer ent "D-3D-CLM") ) ) ;; Set ByLayer color and linetype (if (/= clr 256) (progn (vla-put-color ent 256) (setq prop-errors (1+ prop-errors)) ) ) (if (/= (strcase lt) "BYLAYER") (progn (vla-put-linetype ent "BYLAYER") (setq prop-errors (1+ prop-errors)) ) ) ;; Track invalid types and linetypes (if (not (member ename '("AcDbLine" "AcDbPolyline" "AcDbCircle" "AcDb3dSolid" "AcDbSurface" "AcDbArc" ) ) ) (setq enttype-errors (1+ enttype-errors)) ) (if (not (member (strcase lt) '("BYLAYER" "CONTINUOUS" "CENTER")) ) (setq ltype-errors (1+ ltype-errors)) ) ) ;; Delete entities on layer "0" (vlax-for ent ms (if (= (strcase (vla-get-layer ent)) "0") (vla-delete ent) ) ) ;; Set layer 0 current (vla-put-activelayer doc (vla-item (vla-get-layers doc) "0") ) ;;Remove duplicates (command "-OVERKILL" "ALL" "" "") ;; Purge all (repeat 3 (command "_.PURGE" "ALL" "*" "N")) (repeat 2 (command "_.PURGE" "Regapps" "*" "N")) ;; Set UCS/view (command "_.UCS" "_W") (command "_.-VISUALSTYLES" "C" "_CONCEPTUAL") ;; Fixed (command "_.VIEW" "_SWISO") (command "_.ZOOM" "_E") ;; Final checks (setq layers-ok (and (tblsearch "layer" "0") (tblsearch "layer" "D-3D-SOL") (tblsearch "layer" "D-3D-CLG") (tblsearch "layer" "D-3D-CLM") ) ) ;; Build CSV output (setq result (strcat (getvar "DWGNAME") "," (if layers-ok "PASS" "FAIL" ) "," (if (= ltype-errors 0) "PASS" "FAIL" ) "," (if (= enttype-errors 0) "PASS" "FAIL" ) "," (if (= prop-errors 0) "PASS" "FAIL" ) "," (itoa layer-errors) "," (itoa ltype-errors) "," (itoa enttype-errors) "," (itoa prop-errors) ) ) (writecsvheader) (append2csv result) the script i am using to run it is:- (load "C:/Users/me/LIBRARY/AutoCad/AutocadScripts/dwgprocessor.lsp") dpsr qsave close and the batch file used to run the scrpit is:- @echo off setlocal :: Set the path to the folder containing your DWG files set "folderpath=C:\Users\me\ASSETS\DWG\3D\LIGHT" :: Set the AutoCAD Core Console executable path set "AutoCADCoreConsole=C:\Program Files\Autodesk\AutoCAD 2026\accoreconsole.exe" :: Set the path to your LISP file set "lispFile=C:\Users\me\LIBRARY\AutoCad\AutocadScripts\process.scr" :: Loop through all DWG files in the folder for %%f in ("%folderPath%\*.dwg") do ( echo Processing: %%f "%AutoCADCoreConsole%" /i "%%f" /s "%lispFile%" /product ACAD /l en-US ) endlocal when run, dpsr is basically ignored and the next two lines of the script are run:- is it the VL commands causing the issue ? .

i have commented here:-

Its looking like coreconsole cannot run the purge command (unknown command error), which is a big part of what i wanted to do. I have found this link https://www.theswamp.org/index.php?topic=31867.msg373489#msg373489 but it isnt lisp, can this be run within lisp ?.

Hello internet world. I feel like something changed in my CAD a couple months ago and I can't double click a block to open the Block Editor anymore. I started getting this message "The selected block has no editable attributes." I've been getting by by using either REFEDIT or BEDIT but it's annoying not being able double click. For both Blocks and Dynamic Blocks, the double click action in the CUI is set to BEDIT. This affects all blocks in all drawings. I've attached a sample drawing if it helps. Any ideas? Thank y'all in advance!! Drawing1.dwg

Hi I found the lisp below, it looks like it could do what I want but I can't see how to change it to remove unreferenced PDF underlays, any advice please? https://www.cadtutor.net/forum/topic/96952-lisp-to-remove-unreferenced-xref/#comment-664904 ;; PurgeImages.lsp by Trevor Bird ;; Removes Unreferenced Images ;; 2021-02-20 ;;------------------------------------------------------------------------------ (defun purgeimages ( / ACAD_IMAGE_DICT__dxf ACAD_IMAGE_DICT__ename ACAD_REACTORS__dxf assoc_330 count_imagedef count_imageref count_purged dps_3 dps_330 entity_dxf entity_ename entity_type imagedef_dxf imagedef_ename ImageFile imageref_dxf imageref_ename list_ImageNames ) (setq count_purged 0) (cond ( (not (setq ACAD_IMAGE_DICT__dxf (dictsearch (namedobjdict) "ACAD_IMAGE_DICT")))) ( (not (setq ACAD_IMAGE_DICT__ename (cdr (assoc -1 ACAD_IMAGE_DICT__dxf))))) ;; dps_3 = xrecord names = image names ( (not (setq dps_3 (vl-remove-if-not '(lambda ( _dp ) (= (car _dp) 3)) ACAD_IMAGE_DICT__dxf)))) ;; List of xrecord names = list of image Names ( (not (setq list_ImageNames (mapcar 'cdr dps_3)))) (list_ImageNames (foreach fe__ImageName list_ImageNames (setq imagedef_dxf (dictsearch ACAD_IMAGE_DICT__ename fe__ImageName) imagedef_ename (cdr (assoc -1 imagedef_dxf)) ImageFile (cdr (assoc 1 imagedef_dxf)) );setq (cond ( (not (setq ACAD_REACTORS__dxf (member '(102 . "{ACAD_REACTORS") imagedef_dxf)))) ( (not (setq ACAD_REACTORS__dxf (reverse (member '(102 . "}") (reverse ACAD_REACTORS__dxf))) dps_330 (vl-remove-if-not '(lambda ( _dp ) (= (car _dp) 330)) ACAD_REACTORS__dxf) );setq );not ); (dps_330 (setq count_imagedef 0 count_imageref 0 );setq (foreach fe__dp dps_330 (setq entity_ename (cdr fe__dp) entity_dxf (entget entity_ename) entity_type (cdr (assoc 0 entity_dxf)) );setq (cond ( (not (= entity_type "IMAGEDEF_REACTOR"))) ( (not (setq count_imagedef (1+ count_imagedef)))) ;; 330 - Object ID for associated image object (image reference) ( (not (setq assoc_330 (assoc 330 entity_dxf)))) (assoc_330 (setq imageref_ename (cdr assoc_330) imageref_dxf (entget imageref_ename) );setq (cond ( (not imageref_dxf) ;; Image reference was deleted. );(not imageref_dxf) (imageref_dxf (setq count_imageref (1+ count_imageref)) );imageref_dxf );cond );assoc_330 );cond );fe__dp (if (zerop count_imageref) (progn ;; Delete image definition xrecord. (setq count_purged (1+ count_purged)) (entdel imagedef_ename) (dictremove ACAD_IMAGE_DICT__ename fe__ImageName) (princ "\nDeleting image ") (prin1 fe__ImageName) (princ ".") );progn );if );dps_330 );cond` );fe__ImageName );list_ImageNames );cond (cond ( (not (zerop count_purged)) (princ "\n") (prin1 count_purged) (if (> count_purged 1) (princ " images ") (princ " image ") );if (princ "deleted.") );(not (zerop count_purged)) ( (zerop count_purged) (princ "\nNo unreferenced images found.") );(zerop count_purged) );cond (princ) ) ;c:purgeimages