Leaderboard
Popular Content
Showing content with the highest reputation on 01/06/2023 in all areas
-
This looks easier than I though. There are a few options for steal, such as below, StealLast (which steals from the last drawing you stole from) Each of these options have this line (steal <dwg> <lst> ) which calls the main routine.... so use MHUPPs latest drawing to get the drawing name (and filepath, probably taking note of double \\ in there too), then simple (steal MyDrawing.dwg) will bring up the dialogue box to select what to steal. if you also look at the StealAll LISP this will give you a clue at what to do to set what to steal each time (a few fewer button presses and dialogue box) Play with it over the weekend! (defun c:StealLast nil (Steal (if (setq dwg (getenv "LMac\\StealLast")) (findfile dwg) ) nil ) ) MHUPP - going to 'steal' what you did for something else that has been in the back of my mind for ages, a batch process selecting that days work for example to plot or PDF what I have done, think DatMod (vlax-get FilObj 'DateLastModified) will do the trick!2 points
-
Thanks guys Yeah, I see where this could go now... Thanks Mhupp for that snippet of code, and yeah if you have time StevenP some hints would be appreciated. Don't worry if you don't have time, your last post and Mhupps post has given me a great starting point to play with.2 points
-
This will create a list of files in the given folder from newest to oldest. (setq FilSys (vlax-create-object "Scripting.FileSystemObject") path "C:\\Folder\\path" ) (foreach F (vl-directory-files path "*.DWG" 1) (setq FilObj (vlax-invoke FilSys 'GetFile (strcat path "\\" F)) DatMod (vlax-get FilObj 'DateLastModified) lst (cons (cons F DatMod) lst) ) ) (vlax-release-object FilObj) (vlax-release-object FilSys) (setq lst (mapcar '(lambda (l) (car (nth l lst))) (vl-sort-i lst '(lambda (d1 d2) (> (cdr d1) (cdr d2)))))) (setq nfile (car lst)) ;newest file in folder ;(setq nfilepath (strcat path "\\" (car lst))) or if you need the full path2 points
-
1 point
-
Just a guess but ssget didn't find anything so ssbo is nil. When calling sslenght on line 479 its looking at nil rather then a selection set and errors. Add an if in front of the ssget. So if it doesn't find anything it skips the code. (if (setq ssbo (ssget '((0 . "LWPOLYLINE") (8 . "BATAS BIDANG")))) (repeat (setq slbo (sslength ssbo)) ... ... (setq klikpolykor (list entbo korbo)) ) ) -edit Its best to post the whole code. Something else could be happening. Its like taking your car the the mechanic but only letting him look at it from 20' away or at a picture and then asking whats wrong.1 point
-
That's the first part of code I use to list all the autosave files from the temp folder. then feed it into @BIGAL's listselect. Good for when the drawing crashed and you want to get the last autosave.1 point
-
Thanks yes I will definitely have some fun with this over the weekend ( Also gives me a chance of getting out of visiting the in laws haha i hope)1 point
-
Lee Mac doesn't post as much as he used to (which is a real shame, every time he does we all learn something). I suspect he lurks in the background. Watching. Reading his posts I suspect if you study his code, learn, understand and then modify it to suit yourself he would be more than happy that he taught you something new also. I haven't looked at the Steal LISP, accepting it works well for me. Might be that you'd want to take out the file selection part into a separate LISP (Lee Mac calls this idea a wrapper) which then passes the file details to the steal command? get that working - make sure you have the code correct - and then use MHUPP above to make a new LISP, selecting the latest file to use. You get 2 LISPs then, classic steal and newest file steal both using the same basic code Depends how the afternoon goes it might interest me to look at this to give you some hints - first week after the new year, half the Engineers are on holiday, it might be quiet.1 point
-
StevenP I like the scripting that you've shown I've only ever done basic scripts, I did not realize that Visual-lisp could be used in script but i suppose anything that can be passed at the command line can be in a script file... It just never occurred to me that it could be more than just basic commands I'll definitely be looking to improve on some of my existing scripts from now on.... I'm really glad I opened this thread on here... I've got so much extra information and knowledge already (and now given myself more work to do haha but for the good for future work)1 point
-
Hi mhupp I'm not sure what the issue is, but when I "appload" in the lisp above i get an error message "Autolisp Error:syntax error", it looks okay to me but I am a novice lol I've been using the "steal.lsp" today, its an awesome piece of code, and using the "StealAll" command it does what i need, and its better than my current method. If I had 1 wish, it would be, instead of me having to choose the drawing to steal from, as per my needs it would always choose the newest file in a specific directory, thereby shortening the process. I'm not sure if this is within my current level of knowledge to do, but i've got a weekend to give it a try (if you don't mind me making changes to your lisp file @Lee Mac? I won't try to make any changes without your approval mate, I appreciate all the time and effort that goes into these projects)1 point
-
Like Mhupp this has been asked before, just a comment look at the GPS on the dash of your car or phone. It has the algorithm worked out. Check when googling Forums/autodesk answers are there.1 point
-
Still has potential not to find the shortest path if you default to the shortest distance between points. You have to check each path and add up the total distance and compare. Because leg one could be shorter in p1 A1 but then all other legs are longer. in that if you when p1 B1 the first leg is longer but the difference is made up over the total distance that it ends up being shorter. Maybe someone smarter then me can figure this out @marko_ribar perhaps.1 point
-
@Aftertouch Glad you got it working FWIW I'd refactor the code like so: (vl-registry-write (setq regeditetransmit (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Etransmit\\setups\\COMPANY SETUP" ) ) ) (foreach pair '(("AEC_EXPLODE_DWG" 0) ("AEC_TEMP_SETUP" 0) ("BindType" 0) ("BindXref" 0) ("Description" "") ("DestFile" "") ("DestFileAction" 0) ("DestFolder" "") ("FilePathOption" 0) ("IncludeDataLinkFile" 1) ("IncludeFont" 1) ("IncludeMaterialTextures" 1) ("IncludePhotometricWebFile" 1) ("IncludeSSFiles" 1) ("IncludeUnloadedReferences" 0) ("Name" "COMPANY SETUP") ("PackageType" 0) ("PurgeDatabase" 0) ("RootFolder" "") ("SaveDrawingFormat" 6) ("SendMail" 0) ("SetPlotterNone" 0) ("ShowInFolder" 0) ("UsePassword" 0) ("VisualFidelity" 1) ) (vl-registry-write regeditetransmit (car pair) (cadr pair)) )1 point
-
You have to do that in the printer settings. View your system’s printers (there are several ways to get there) Control Panel > Devices and Printers (Easiest) OR Settings > Printers & Scanners Select any Printer Select Print Server Properties on the toolbar above the printers or from Related Settings at the right hand side Select the Forms tab Click “Create a New Form” checkbox Enter the custom width and height Click OK1 point
-
1 point
-
Hello friends, I recently was thinking on how to entmake an arc with 2 points and a radius, and since I couldn't find a solution without knowing the center point created this solution by using a lwpolyline, I don't know if it ever is useful for you or not, but if it ever happens to be useful to you give me a like or just credit. ;;; Program to create a curved lwpolyline with 2 points and a radius ;;; By Isaac A. 20220523 ;;; V1.1 (defun c:parc (/ bcal cw end r start) (while (= nil (setq start (getpoint "\nPick the start point"))) (setq start (getpoint "\nPick the start point")) ) (while (= nil (setq end (getpoint "\nPick the end point"))) (setq end (getpoint "\nPick the end point")) ) (setq r (getreal "\nGive me the radius: ")) (while (< r (/ (distance start end) 2.)) (setq r (getreal (strcat "\nThe radius can't be less than " (rtos (/ (distance start end) 2.) 2 2) ": "))) ) (setq bcal (ia:bulge start end r)) (initget 1 "Clockwise counterclockWise") (setq cw (getkword "\nSelect the path of the arc Clockwise/counterclockWise: ")) (if (= cw "Clockwise") (setq bcal (* -1 bcal)) ) (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(8 . "newlayer") '(62 . 5) '(38 . 0.0) (cons 90 2) '(70 . 0) (cons 10 start) (cons 42 bcal) (cons 10 end) '(42 . 0.) ) ) (princ) ) ;;; ia:bulge Obtains the bulge to be used on a curved lwpolyline ;;; based on 2 points and radius (defun ia:bulge (p1 p2 r / d d-2 d-4 n) (setq d (distance p1 p2)) (if (>= r (/ d 2)) (progn (setq n (/ d (* 2. r)) d-2 (cond ((equal n 1. 1e-9) (/ pi 2.)) ((equal n -1. 1e-9) (/ pi -2.)) ((< -1. n 1.) (atan n (sqrt (- 1 (expt n 2)))) ) ) d-4 (/ d-2 2.) ) (/ (sin d-4) (cos d-4)) ) (princ "\nThe radius is incorrect") ) ) Hoping it ever gets useful to anyone. Happy coding.1 point
-
Below is a short routine to find the shortest distance between a point and a line. The osnap settings dialog will popup first to allow setting of the relevant osnap mode for the points. You will then be asked to select a line. This can be a polyline. The lisp will then repeatedly ask for a point and display the shortest distance to the line. To exit and rerun press ESC (vl-load-com) (defun c:shortest ( / *error* cmde o_lin pt c_pt ) (defun *error* ( msg ) (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred."))) (if cmde (setvar 'cmdecho cmde)) (princ) );_end_*error*_defun (command "dsettings") (if (/= (getvar 'cmdecho) 0) (progn (setq cmde (getvar 'cmdecho)) (setvar 'cmdecho 0))) (setq o_lin (vlax-ename->vla-object (car (entsel "\nSelect Line for Shortest Distance TO : ")))) (while (setq pt (getpoint "\nSelect Point for Shortest Distance FROM : ")) (setq c_pt (vlax-curve-getclosestpointto o_lin pt)) (setq dist (distance pt c_pt)) (princ (strcat "\Shortest Distance = " (rtos dist 2 3))) );_end_while );_end_defun1 point
-
An Introduction to... Creating Layers Using Entmake Reference for Layer DXF Group Codes A Basic Example Here is perhaps the simplest version of a function to create a layer using the entmake function, given a layer name: (defun _layer ( name ) (if (null (tblsearch "LAYER" name)) (entmake (list '(000 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(070 . 0) (cons 002 name) ) ) ) ) The code simply says: "If the layer doesn't exist in the Layer Table (tblsearch check), use entmake to create it". The above may be called in the following way to create a layer named 'Test': (_layer "Test") Hence, to create multiple layers we could call the above function from another function: (defun c:test ( / ) (foreach layer '( "Layer1" "Layer2" "Layer3" ) (_layer layer) ) (princ) ) Which would create three layers: "Layer1", "Layer2" and "Layer3" with default properties (i.e. Colour = White, Linetype = Continuous, etc.). Refining the Properties Referring to the DXF Reference hyperlinked above, note the DXF Group Codes for the following basic properties: 2 = Layer Name 6 = Layer Linetype 62 = Layer Colour 290 = Layer Plotting Flag 370 = Layer Lineweight Enum Hence, to expand the '_layer' function to include the option to specify a Layer Colour, we need to include DXF Group Code 62: (defun _layer2 ( name colour ) (if (null (tblsearch "LAYER" name)) (entmake (list '(000 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(070 . 0) (cons 002 name) (cons 062 colour) ) ) ) ) The function '_layer2' now requires an extra parameter (the layer colour) when called: (_layer2 "Test Colour" 3) Would create a Green Layer (colour 3) called "Test Colour". Again, there are many ways this revised function could be called from another program to create multiple layers, here are a few examples: Using a foreach loop with an association list: (defun c:test2 ( / ) (foreach pair '( ("Layer4" 1) ("Layer5" 3) ("Layer6" 2) ) (apply '_layer2 pair) ) (princ) ) Using a mapcar expression: (defun c:test2 ( / ) (mapcar '_layer2 '("Layer4" "Layer5" "Layer6") '(1 3 2)) (princ) ) (For more on mapcar, see here) Adding More Properties Let us now add some more properties to the function: (defun _layer3 ( name colour linetype lineweight plot ) (if (null (tblsearch "LAYER" name)) (entmake (list '(000 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(070 . 0) (cons 002 name) (cons 006 linetype) (cons 062 colour) (cons 290 plot) (cons 370 lineweight) ) ) ) ) This function '_layer3' now includes the DXF Group codes for the layer name (DXF 2), colour (DXF 62), linetype (DXF 6), lineweight (DXF 370) and the plotting flag (DXF 290). However, when calling the function we need to be careful to use the correct data types for these Group Codes. For example, the lineweight (DXF 370) must be an integer value equal to the decimal lineweight multiplied by 100. Hence a lineweight of 2.11mm would have a DXF Group 370 value of 211. Similarly, the plotting flag (DXF 290) requires an integer value of either 0 (layer won't plot) or 1 (layer will plot). And so we might call the function '_layer3' in the following way: (_layer3 "Test Props" 4 "Continuous" 40 1) This would create a plottable layer called "Test Props" with a Layer Colour of 4 (Cyan), Continuous Linetype, and a Lineweight of 0.40mm. Note that when supplying the DXF Data list to the entmake function, the Linetype assigned to DXF Group 6 must exist in the Linetype Table (i.e. be loaded in the drawing) for the layer to be created. With this in mind we can add some error trapping to the code to allow for linetypes which are not loaded, and set the layer to use a Continuous linetype for these cases: (defun _layer4 ( name colour linetype lineweight plot ) (if (null (tblsearch "LAYER" name)) (entmake (list '(000 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(070 . 0) (cons 002 name) (cons 006 (if (tblsearch "LTYPE" linetype) linetype "Continuous" ) ) (cons 062 colour) (cons 290 plot) (cons 370 lineweight) ) ) ) ) Again this function could be called from another program to create many layers at once, as the following example demonstrates: (defun c:test4 ( / ) (foreach item '( ("Layer7" 4 "HIDDEN" 40 1) ("Layer8" 3 "Continuous" 90 0) ("Layer9" 2 "PHANTOM" 20 1) ) (apply '_layer4 item) ) (princ) ) Other properties can be refined by modifying other values of the DXF data list, such as the DXF Group 70 bitflag value to control whether the layer is Locked, Frozen, or Frozen in VP when created; however, I shall save these for another day. An Extension: Modifying Existing Layers This final extension demonstrates how to allow the function to modify the properties of existing layers should the layer already exist in the Layer Table when the function is called. The following is a more advanced function I wrote some time ago, I shall post it here as a final example: (defun LM:CreateLayer ( name color ltype lnwt plot ) ( (lambda ( _function ) (_function (list '(000 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(070 . 0) (cons 002 name) (cons 006 (if (tblsearch "LTYPE" ltype) ltype "Continuous")) (cons 062 color) (cons 290 plot) (cons 370 lnwt) ) ) ) (if (tblsearch "LAYER" name) (lambda ( data ) (entmod (cons (cons -1 (tblobjname "LAYER" name)) data))) entmakex ) ) ) Hence, to modify "Layer9" from the earlier example, I could call: (LM:CreateLayer "Layer9" 5 "Continuous" 211 0) Or, to create a new "Layer10", (or modify if it already exists): (LM:CreateLayer "Layer10" 6 "HIDDEN" -3 1) Note the use of "-3" as the Lineweight Enum to indicate a 'Default' Lineweight setting. Thats about all I have time for, but I hope this helps. If you have any questions about what I have posted, just ask. Happy coding, Lee1 point