All Activity

Yes, you are correct. Top will always be the XY plane. If you rotate your UCS 90 degrees, you will see the Viewcube update and "Top" will now be on the side of the Viewcube.

My UCS icon disappeared in the model. I just turned it back on using UCSICON command. Anyway, to draw on the right plane. Did I understand it correctly per screenshot? For XY plane would TOP and Bottom on viewcube considered as XY plane? Just want to clarify.

@RBrigido I am not sure (vl-string-search) will work correctly since it looks at each character in the pattern individually. I recommend using (wcmatch) instead. Also - just a suggestion to shorten code; you could shorten this: (setq filtered-files '()) (foreach file files (if (not (vl-string-search "ABR" file)) (setq filtered-files (cons file filtered-files)) ) ) to This: (setq filtered-files (vl-remove-if '(lambda (x) (wcmatch x "*ABR*")) files)) And, since your already using Visual LISP, you should put (vl-load-com) at the top of your function.

@enthralled A little trickier with getting and setting transparency - but almost all can be done fairly easily with Visual LISP Activex functions. ;; New version by Pkenewell. Uses Visual LISP & ActiveX (defun C:CNL ( / acdoc cnt el la llst lt lw lyrs np nl ss su tr) (vl-load-com) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) lyrs (vla-get-layers acdoc) ) (vla-StartUndoMark AcDoc) (if (and (setq ss (ssget ":L")) (setq su (getstring T "\nEnter suffix for new layers for selected objects: ")) ) (progn (repeat (setq cnt (sslength ss)) (setq el (entget (ssname ss (setq cnt (1- cnt)))) la (cdr (assoc 8 el)) ) (if (not (member la llst))(setq llst (cons la llst))) ) (foreach n llst (setq ob (vlax-ename->vla-object (setq el (tblobjname "LAYER" n))) col (vla-get-truecolor ob) lt (vla-get-linetype ob) lw (vla-get-lineweight ob) np (vla-get-plottable ob) tr (getpropertyvalue el "Transparency") nl (vla-add lyrs (strcat (vla-get-name ob) su)) ) (vla-put-truecolor nl col) (vla-put-linetype nl lt) (vla-put-lineweight nl lw) (vla-put-plottable nl np) (setpropertyvalue (vlax-vla-object->ename ob) "Transparency" tr) ) ) ) (vla-EndUndoMark AcDoc) (princ) )

How about you try something like this, see if it works. (defun c:test () (setq directory "C:\\Folder\\To\\Your\\Directory\\") (setq files (vl-directory-files directory "*.dwg" 1)) (setq filtered-files '()) (foreach file files (if (not (vl-string-search "ABR" file)) (setq filtered-files (cons file filtered-files)) ) ) (princ "\n.dwg files that do not contain 'ABR' in the name:\n") (foreach file filtered-files (princ (strcat directory file "\n")) ) (princ) )

I'm using vl-directory-files to get a list of files. I know how to use a wildcard to only grab files that contain a certain string of characters (ex. ABR*.dwg) but how do I only grab files that DO NOT contain a string of characters? For instance, grab all .dwg's which do not have "ABR" in their name?

I got this far with the help of ai, it does what I need with the exception of inheriting parent layer Transparency: ;; Modified from pkenewell's lisp: https://www.cadtutor.net/forum/topic/56459-move-to-new-layer-with-suffix/#comment-556088 (defun C:cnl ( / ss cnt el en la llst lt nlst ol suff newLayerProps) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-StartUndoMark AcDoc) (setq ss (ssget ":L") cnt 0) (repeat (sslength ss) (setq el (entget (ssname ss cnt)) la (cdr (assoc 8 el)) cnt (1+ cnt) ) (if (not (member la llst)) (setq llst (cons la llst))) ) (if (setq suff (getstring T "\nEnter suffix for new layers for selected objects: ")) (progn (setq nlst (mapcar '(lambda (x) (strcat x suff)) llst) cnt 0) (foreach i nlst (if (not (tblsearch "LAYER" i)) (progn (setq ol (tblsearch "LAYER" (substr i 1 (- (strlen i) (strlen suff))))) (if ol (progn (setq newLayerProps (entget (tblobjname "LAYER" (cdr (assoc 2 ol))))) (setq newLayerProps (subst (cons 2 i) (assoc 2 newLayerProps) newLayerProps)) (entmakex newLayerProps) ) ) ) ) (setq cnt (1+ cnt)) ) (setq cnt 0) (repeat (sslength ss) (setq en (ssname ss cnt) el (entget en) la (cdr (assoc 8 el)) el (subst (cons 8 (strcat la suff)) (assoc 8 el) el) cnt (1+ cnt) ) (entmod el) ) ) ) (vla-EndUndoMark AcDoc) (princ) )

I appreciate your comment @BIGAL. You made me have a clearer vision of Lisp and managed to complete it successfully. I share the final code below so that everyone can use it in the future: (prompt"\n \n \n Loading Label Lines.lsp file.") (prompt"\n (c) Rodrigo Brigido 2024...") (prompt"\n Create labels on lines....") ;Name : Label Lines.lsp ;Command : Label Lines ;Output : --- ;By : Rodrigo Brigido ;Created : ;Modified : --- ;Description : Create labels on lines (defun c:lab () (c:labelline) ) (defun c:labelline () (setvar "cmdecho" 0) (setq oldorthomode (getvar "orthomode")) (setvar "orthomode" 0) (setq oldosmode (getvar "osmode")) (setvar "osmode" 512) (setq p1 (getpoint "\nSpecify first point of fence: ")) (setq p2 (getpoint p1 "\nSpecify second point of fence: ")) (setq fence (list p1 p2)) (setq fence_ss (ssget "_f" fence '((0 . "*Lwpolyline,3dpoly,polyline,Line")))) (if fence_ss (progn (setq count (sslength fence_ss)) (setq i 0) (while (< i count) (setq ent (ssname fence_ss i)) (setq intersect_point (c:get-intersect-point ent fence)) (c:create-text intersect_point ent) (setq i (1+ i)) ) ) (prompt "\nNo contours found within the fence.") ) (setvar "orthomode" oldorthomode) (setvar "osmode" oldosmode) (setvar "cmdecho" 1) (princ) ) (defun c:get-intersect-point (ent fence) (if (and (entget ent) (cdr (assoc 10 (entget ent)))) (progn ; Getting the entity endpoints (setq ent_pts (cdr (assoc 10 (entget ent)))) (setq ent_start_pt (car ent_pts)) (setq ent_end_pt (cadr ent_pts)) ; Getting the fence endpoints (setq fence_start_pt (car fence)) (setq fence_end_pt (cadr fence)) ; Calculating the intersection point (setq intersect_point (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent) fence_start_pt)) ) (progn ; Debug message if entity is not found or points are not defined (princ "\nEntidade não encontrada ou pontos não definidos.") nil ) ) ) (defun c:point-on-segment-p (point p1 p2) (let ((x (car point)) (y (cadr point)) (x1 (car p1)) (y1 (cadr p1)) (x2 (car p2)) (y2 (cadr p2))) (if (<= (min x1 x2) x (max x1 x2)) (if (<= (min y1 y2) y (max y1 y2)) t nil) nil) ) ) (defun c:create-text (point ent) (if (and point ent) (progn (setq layer_name (cdr (assoc 8 (entget ent)))) (c:extract-label-from-layer-name layer_name) ; Extract X and Y coordinates from the intersection point (setq x (car point)) (setq y (cadr point)) ; Calculate rotation angle (setq angle (c:calculate-angle ent)) ; Debug message (princ (strcat "\n\n\nCreating text \"" cleaned_name "\" at point: (" (rtos x) ", " (rtos y) ") with rotation angle: " (rtos angle))) ; Create text (setq text_data (list (cons 0 "TEXT") (cons 8 "0-25TXT_NCW") (cons 10 (list x y 0)) (cons 40 0.3) (cons 41 0.6) (cons 1 cleaned_name) (cons 50 angle))) ; Adding rotation angle (entmake text_data) ) ) ) (defun c:create-text (point ent) (if (and point ent) (progn (setq layer_name (cdr (assoc 8 (entget ent)))) (c:extract-label-from-layer-name layer_name) ; Extract X and Y coordinates from the intersection point (setq x (car point)) (setq y (cadr point)) ; Calculate rotation angle (setq anglea (angle '(0. 0. 0.) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent point)))) ; Debug message (princ (strcat "\n\nCreating text \"" cleaned_name "\" at point: (" (rtos x) ", " (rtos y) ") with rotation angle: " (rtos anglea))) ; Create text (setq text_data (list (cons 0 "TEXT") (cons 8 "0-25TXT_NCW") (cons 10 (list x y 0)) (cons 40 0.3) (cons 41 0.6) (cons 1 cleaned_name) (cons 50 anglea))) ; Adding rotation angle (entmake text_data) ) ) (princ) ) (defun c:extract-label-from-layer-name (layer_name) (if layer_name (progn (setq cleaned_name (vl-string-subst "" "_NCW" layer_name)) ; Remove "_NCW" (setq cleaned_name (vl-string-subst " " "_" cleaned_name)) ; Replace "_" with white space when between two letters (setq parts (vl-string-split cleaned_name " ")) ; Split cleaned_name using " " as delimiter (if (> (length parts) 1) ; Checks if there is more than one element in the list (car parts) ; Returns the first element ) ) ) ) ;##### Credits to @Bigal ######

Are you using a LISP to change units? Can you post a .dwg?

Hey, Sorry for the late reply! The code provided was incredibly helpful for what I needed back then. Now, I need it to retain all the original layer properties, including any color types, line weights, line types, and transparency settings, if possible. Any input would be greatly appreciated! Thanks

My autocad was working fine until a few days back. Recently when i am changing the units from inches to millimeter and then attempt to draw a line it still comes in inches. But in the unit box it shows millimeters. Please let me know what i can do.

Hi Bigal, Thanks for your efforts and support. These are the points from Survey data which has many features and there are a lot of areas. Each area has to be given a point report in excel and the corresponding number is to be shown in the drawing. After the Point report or point numbering of an area, there should be a blank line in Excel and again a next area has to follow with the Point number starting from 1 to xxxxx. Here using the code pnum, I generated the numbers for all of the points and then I started exporting the Point number text to excel individually by Data Extraction. Here there is a problem while numbering all the points in the entire drawing the numbers are not continuously assigned for an area. So I did the area each individually and then the Data extraction. I was looking for a code that will add numbers and export to excel and save with a unique name so I can copy from all these generated excels to 1 excel file with a blank line between each area. Thanks again

When you use the default palettes, yes, it does save the settings. Instead of using the default palettes, we create deployable modular tool palettes. We use the *_TOOLPALETTEPATH to point autocad to an ATC file and palette set which loads right up. It eliminates having to manually load each palette, or unload them when there are updates to them. The issue i am trying to fix is that the view settings for icon size resets every time you change the path. Docking the palette and setting its width is to ensure our users can read everything as intended.

Does it not remember last settings ? I dont use tool palettes. Maybe save workspace. The values are possibly buried away in the Registry. But be careful doing regedit.

"Can this code be updated to export the text coordinates, Value and layers to excel?" YES but new code. Can send direct to excel. Last number can be found by searching text and checking its value, > oldtext newtext, so save highest value as a number. I just wonder why a point manager Hint Lee-Mac, was not used in 1st place if these are imported points. Or if they have been manually added why not use a block with POINT & 1 Attribute. Much easier to handle than plain text. Please respond about where points are coming from. Have a couple of off the shelf solutions.

I have done something similar where you select block and its tag and current value are displayed in a dcl so you edit and it makes a list of all attributes, the update of the block ignores tag names rather updates based on attribute order so actually updates all attributes. The dcl code uses my Multi getvals.lsp so that is done. As you want to do multi dwg it needs to be a 2 step process select block and do edits then save in say a file, then run across multiple dwg's reading the file for values. Going further blank out values then can set those to not update they have a value of "". This example is pushing the screen size as it has 25 attributes. You just edit the attribute values. (defun getatttagnames (obj / ) (setq lst '()) (setq atts (vlax-invoke obj 'getattributes)) (foreach att atts (setq lst (append (list (vla-get-textstring att) 29 30 (vla-get-tagstring att) ) lst) ) ) ) (defun wow ( / ss lst obj att atts str) (setq ss (ssget "x" '((0 . "INSERT")(2 . "EPCB000")))) (setq obj (vlax-ename->vla-object (ssname ss 0))) (getatttagnames obj) (setq lst (reverse lst)) (setq lst (cons "Please edit" lst)) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm lst)) (setq x -1) (foreach att atts (setq str (nth (setq x (1+ x)) ans)) (if (= str "") (princ) (vla-put-textstring att str) ) ) (princ) ) (wow) PS there is a line spacer in the dcl code so I think somewhere did a version when you have lots of rows it is left out. Line 33 in multi getvals. Multi GETVALS.lsp

Try (setq stringa "") (while (setq att (car (nentsel "\nSeleziona attributo: "))) (setq stringa (strcat stringa (cdr (assoc 1 (entget att))) " ")) ) (princ (strcat "\n" stringa)) ; command line (alert stringa) ; message box

Just some thoughts a closed pline use (vla-offset after checking is CW or CCW. Then revcloud (entlast). A single line is 4 offset points extend ends then revcloud using those points. An open pline again offset in & out, extend ends and join ends, join all segments, then revcloud (entlast) no need for complex bulge calcs. Hopefully no arcs at start or end. Will have a go later.

Not sure as don't use electrical but in CAD you can set the dwt to be used, try Options, Templates.

Wow. That is amazing. Thank you for putting the effort. This is very helpful. I tried to follow YouTube but couldn’t find your channel. Thanks

Hello, I am not great with LISP, so before I dive into the deep end, i wanted to ask: If the user enters the TOOLPALETTES command, the floating Tool Palettes context window will open. I was wondering if its possible to use LISP to do the following: 1. Anchor the Tool Palettes window to the Right side of AutoCAD 2. Turn off the Auto-Hide 3. Stretch the docked window to 300 pixels in width 4. Set all images on all palettes to their maximum size Thank you in advance!!

Resurrecting an old thread, but I did a bunch of searching and this lisp routine does just about exactly what I'm looking to do, except I'm a total noob and can't figure out how to change it to: 1) force the z elevation to 0 - a 2d point would be preferred (I know I can change it to 0 in the CSV file, but it's got to be easy enough to force it through the routine and save the manual processing) 2) keep the original layer of the block being imported instead of it being put on the current layer Does anyone happen to know what would need to be done? Thanks in advance, AJT

I just made a video about the Solidedit command. Maybe this will help:

On the picture. I tried to move the hole 1/16 in to the right using SOLIDEDIt command per method below, but when i selected, the whole thing was selected. Is that because I have subtracted the holes? How can I move the hole within redraw new one? Is there a different way to do?