Search the Community

Hello everyone, Another productive day and a couple days really coding in AutoLISP. I'm here to share with you an automated annotation block placement that I wrote with the help of chatGPT (for helper functions), referencing all the experts in this forum and some of my wit in trying to optimize it. Here we have an ent (which is an entity name) that we want to put callup bubbles on and we're using a multileader-ish block called RSBALLOON + LEADER, which I have in my library. This is basically a block that has a leader on it that is modified using LM:setdynpropvalue. We actually just use ssget as a filtering tool used in boundscan, which is just a ssget crossing selection knowing the area you specify. I've learned a few lessons when I coded this. If you set this iteratively, this will have issues because the 'point' will drift. LISP fumbles where to place your blocks. You can "regen" everytime you place a block but that costs time. I've solved this by using a separate function that zooms into a viewport per entity that I'm doing a calculation on. Mind you, this block placement task usually takes a couple of hours to do manually because you want it to look pretty and visible with no obstructions. Now it only takes under a minute. I haven't really cleaned up the code but I was so excited in sharing this accomplishment. (defun MA:susp-callup-insert (ent radlist anglelist / entloc spc point blkobj) ; (setq radList (list 600 700 800 900 1000 1100 1200 1300 1400)) ; (setq anglelist (list 45 15 75 315 345 285 135 165 105 225 195 255 30 60 330 300 150 120 210 240 35 55 25 65 5 85 325 305 335 295 355 275 45 125 ....)) (setq entloc (cdr (assoc 10 (entget ent)))) (setq entloc (subst 0.0 (caddr entloc) entloc)) (setq spc (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace ) ) ) (setq blkname "RSBALLOON + LEADER") (setq blkobj nil exitLoop1 nil exitLoop2 nil idxrad 0 rad (nth 0 radlist) ) ;(start-timer) (while (and (not exitLoop1) rad) (setq idxang 0 exitLoop2 nil ang (nth 0 anglelist) ) (while (and (not exitLoop2) ang) (progn (setq angrad (deg2rad ang)) (setq point (mapcar '+ entloc (list (* rad (cos angrad)) (* rad (sin angrad)) 0.0 ) ) ) (if (not (boundScan point 200)) (progn ; (setq blkobj (vla-insertblock ; spc ; (vlax-3D-point point) ; blkname ; 50 ; 50 ; 50 ; 0.0 ; ) ; ) ;(command "UCS" "W") (command "_.insert" blkname point 50 50 0.0) ;(command "regen" ) (setq blkobj (vlax-ename->vla-object (entlast))) (LM:setdynpropvalue blkobj "Distance1" rad) (LM:setdynpropvalue blkobj "Angle1" (+ pi angrad)) (LM:vl-setattributevalue blkobj "ITEM_NO" (LM:vl-getattributevalue (vlax-ename->vla-object ent) "ITEM_NO" ) ) ;(command "_regen") (setq exitLoop2 T exitLoop1 T ) ) ; exit progn ) ; end if (setq ang (nth (setq idxang (+ 1 idxang)) anglelist)) ) ) (setq rad (nth (setq idxrad (+ 1 idxrad)) radList)) ) ;(end-timer) ; (princ "Let's goooooooooo!!!!\n") ; (princ) )

This is just caution for those of you who would like to sort your lists of any kind. If you're dealing with integers in your compare function, vl-sort will ruin your list. I have a very simple test case for this. Suppose: (setq lst '(0 0 0 1 0 0 0)) And you want to sort this list such that: sort-list = (0 0 0 0 0 0 1) You think you would use a simple implementation of vl-sort like the following: (setq sort-list (vl-sort lst '(lambda (s1 s2) (<= s1 s2)))) It seems alright and you even considered that two values might be the same. So, fine and dandy, right? WRONG What this will show is that: sort-list = (0 1) Now you lost information. Now, you might be working with a list of entity names and you use the compare function. '(lambda (s1 s2) (<= (atoi (LM:vl-getattributevalue (vlax-ename->vla-object s1) "ITEM_NO") (atoi (LM:vl-getattributevalue (vlax-ename->vla-object s2) "ITEM_NO"))) How will you be able to know that it didn't just skip or remove a block from your sorted list. Should you even trust this function? *end of rant*

It's intuitive to know that 90 degrees and 270 degrees are collinear assuming the same reference point and 0 degrees. It gets harder to test for other angles though. This gets even more frustrating to test if your angle is negative, or more than 2*pi in radians. ;********************************************************; ;; MA:str8_ang - Check if two angles are straight (collinear) ;; Arguments: ;; - ang1 (float): First angle in radians ;; - ang2 (float): Second angle in radians ;; Returns: ;; - test (bool): True if the angles are collinear, False otherwise ;; Description: ;; This function checks if two angles are collinear (straight) by calculating the cross product of their corresponding unit vectors. ;; The provided angles are translated to positive equivalents and normalized to the range of 0 to 2π. ;; The function then calculates the unit vectors u and v from the angles and calculates their cross product. ;; If the cross product is nearly zero (within a tolerance), the angles are considered collinear. ;; The function returns True if the angles are collinear, and False otherwise. ;; Usage: (MA:str8_ang ang1 ang2) (defun MA:str8_ang (ang1 ang2 / u1 u2 u3 v1 v2 v3 cross_prod test) (if (and ang1 ang2) (progn ;; Translate negative angles to positive equivalents (if (< ang1 0) (setq ang1 (+ (* 2 pi) (rem ang1 (- (* 2 pi))))) ) (if (< ang2 0) (setq ang2 (+ (* 2 pi) (rem ang2 (- (* 2 pi))))) ) ;; Normalize angles to the range of 0 to 2π (setq ang1 (rem ang1 (* 2 pi))) (setq ang2 (rem ang2 (* 2 pi))) (setq u1 (cos ang1) u2 (sin ang1) u3 0.0 v1 (cos ang2) v2 (sin ang2) v3 0.0 ) (setq cross_prod (list (- (* u2 v3) (* u3 v2)) (- (* u3 v1) (* u1 v3)) (- (* u1 v2) (* u2 v1)) ) ) (if (and (= (car cross_prod) 0.0) (= (cadr cross_prod) 0.0) (< (abs (caddr cross_prod)) 0.005) ) (setq test T) (setq test nil) ) test ; return the test result ) ; end progn ) ; end if ) This basically outputs T if the two angles have the same angle or reflection of each other. Do you guys have an easier way of checking this? A refactor would be nice.

Hello everyone, I've been coding a lot the past few days and I just wanted to share my code for those who may have some use for them, and also for me to keep track of my progress. ;********************************************************; ;; MA:perp-test - Test if two angles are perpendicular ;; Arguments: ;; - a (float): First angle in radians ;; - b (float): Second angle in radians ;; - tol (float): Tolerance value for comparison ;; Returns: ;; - test (bool): True if the angles are perpendicular within the given tolerance, False otherwise ;; Usage: (MA:perp-test a b tol) (defun MA:perp-test (a b tol / test) (if (and a b tol) (if (< (abs (- (abs (cos a)) (abs (sin b)))) tol) (setq test T) (setq test nil) ) ) ) This is a very simple script for when you want to compare two angles, especially of blocks you're working with. This can be modified to where it has a default tolerance value for orthogonality, but that would be a good exercise for you guys to test for yourselves.

Hello guys, I am working in AutoCAD. I am looking for a combined LISP code for creating points for the selected objects at its Endpoints, Midpoints, Center, Geometric center, Node, Quadrant, Intersection & Insertion as per users requirements (options with drop down list mentioning Endpoints, Midpoints, Center, Geometric center, Node, Quadrant, Intersection & Insertion Shall get prompted.) Once I select the required snap then the result shall be creation of points at the chosen object snap. An imaginary Example shall be Like like this, command: POBS(Points at Object Snap)-->prompting for what snap need to be found in the selected objects in the for of drop down list--> Creating points in the selected Object Snaps of the selection set. Actually i had found few LISP codes for the following cases 1.PLE-Points on Line Ends.lsp 2.PAI-Point At Intersection.lsp Thanks for the authors of these above LISP they have saved lot of time till date. Thanks in advance.

Hello guys, I am new to this forum. I need LISP for Selection of alternate lines from the selection set of lines like 1st, 3rd, 5th, .....etc lines in Autocad. I am attaching the file with my requirement. Alternate Selection of lines.dwg Please help me out with an possible lisp solution. Also, Is there a Autocad Plugin to do this? If so Please share the link Thanks in advance, Pranesh Rathinam

I was trying to change the shade plot of a view port by lisp but I didn't see any way to do that through the change properties or through the dxf codes. (progn (setq ss1 (ssget "x" '((0 . "VIEWPORT")))) (command "change" ss1 "" "p") )

This code: (command "new" "S:\\CADCore\\Titleblocks\\Facilities A Model.dwt") Gives me this error: Unknown command "DWT". Press F1 for help. Please help

Good Day, first of all I do not own these files, credits to them (forgot where did I get it) Anyway, I'd like to request a LISP that could compute the TOTAL VOLUME/MASS of SELECTED OBJECTS only, and displayed the result in table just like LAYLENGTH table format. For Example.. LAYER NAME | VOLUME Layer1 | 20 (in cubic meters) Layer2 | 35 (in cubic meters) Layer3 | 9.09 (in cubic meters) my drawing units are mostly in 9,091,687,322.3094 (millimeters) but I need it in 9.09 (cubic meters) if possible, and the table in LAYLENGTH is too small, can it also scale to the size of table in drawing file. Thanks 3DVOL2.lsp LAYLENGTH.txt Drawing1.dwg

Hi all, I installed AutoCAD 2021 three days ago. I am very excited of new features,. When issuing vlide command to enter "Visual LISP Editor", I selected installing AutoCAD AutoLISP Extension. Of course this is a very good method of programming to study and use, but now I am not be able to open traditional "Visual LISP Editor", and I am so confuded searching a way to write my own simple AutoLISP macros. Is it possible to find a way to recover the old and lovely vlisp editor? Any help will be appreciated.

I found this code that compiles the files directly, without those annoying errors from VLISP. (defun c:FAS (/ name lispname outfilename findfas rewritefas) (setvar "cmdecho" 0) (setq name (strcase (getstring "Enter Lisp Name: "))) (setq lispname (strcat "C:\\LISP_Directory\\" name ".LSP" ) ;_end strcat ) ;_end setq (setq outfilename (strcat "C:\\FAS_Directory\\" name ".FAS" ) ;_end strcat ) ;_end setq (setq findfas (findfile outfilename)) (if (not findfas) (vlisp-compile 'st lispname outfilename) (progn (initget "Y N") (setq rewritefas (getkword "Save Over Existing FAS? [Yes or No]: ") ) ;_end setq (if (= rewritefas "Y") (vlisp-compile 'st lispname outfilename) (alert "FAS Compiling Aborted") ) ;_end if ) ;_end progn ) ;_end if (setvar "cmdecho" 1) (princ) ) ;_end defun Best regards.

Dear all, I'm looking for a simple lisp (probably vlisp) routine that can select all leaders of the same type (e.g dot). In other words, i only want to select the dot leaders of all my leaders in the drawing file. Should look something like this: (ssget "x" ("leader")) and ('leadertype 3) Thanks

OK, so i have a "master" drawing with 78 separate layers that represent different options. on these layers i have objects with attributes that represent specific parts. i want to write an lisp that will extract 3 specific attributes from all of the blocks currently thawed and print them to a text file. i have tried using the data-extraction command but it seems to want to select all the block in the drawing unless i select them by hand (something i would like to avoid if possible). any ideas on how to approach this? thanks.

Is there a quick and practical way to get X & Y values on a polyline other than by way of "LIST". because I need the X & Y value just like the 2nd image. Thank you Master. img 1 : https://drive.google.com/open?id=0B1KbDu2x_byvU2F6NlpvNWJrU0k img 2 : https://drive.google.com/open?id=0B1KbDu2x_byvVE9qdmpBLWcxWHM

I’m in the process of updating nearly 400 blocks. I have to change the layer and override the color of one attribute. My test on the first block failed. It's just been a while and I can't remember what I'm missing. My attempt for changing the first one: (progn (setq e (car (entsel )) d (entget e) n_e (entnext e) n_d (entget n_e))) un_d (subst (cons 8 "SYM") (assoc 8 n_d) n_d) un_d (append un_d (list un_d (cons 62 141))) ) (entmod un_d) (entupd (cdr (assoc 330 un_d))) ) I've also tried: (command "_.attsync" "_select" n_e "" )"_Yes") note: as I step through the block entities I will be testing to insure I've got the right block with: (and (= (cdr (assoc 0 n_d)) "ATTRIB") (= (cdr (assoc 2 n_d)) "SIZE") (/= (cdr (assoc 8 n_d)) "SYM") )

When i run a lisp om my computer it gives me an error. the first problem was a missing font ic-romand (i renamed another font to continue). I included the files as attatchment. The path to files should be:C:\Program Files (x86)\ProgeCAD\progeCAD 2014 Professional ENG\Program. With appload i load the file \misc\DK_Load. When i run dk (found in dk_main.lisp) it trows me an error : argument type: stringp nil. It should open a dialog box to enter data Can anyone please help me i have to get this running before monday. Some help would be really apreciated!!!!! PROBLEM SOLVED

I have a series of blocks that I am replacing via lisp routine. But the new blocks are wider than the old ones. So I wrote the routine below to trim the lines that extend into a block. It works intermittently when the block is horizontal. I haven’t added the code to trim the lines if it’s vertical yet because I can’t figure out why the code doesn’t consistently work. The code is below and the attached drawing files has the blocks I’m using as an example. (defun trimblocklines ( ent / e d ins ero bw bh pt1 pt2 ss1 cnt sslen ) (setvar "cmdecho" 0) (setq e ent d (entget e) ins (cdr (assoc 10 d)) ero (* (dxf 50 d) (/ 180 pi)) bw 0.25 bh 0.125 pt1 (list (- (nth 0 ins) (/ bw 2)) (- (nth 1 ins) (/ bh 2)) (nth 2 ins)) pt2 (list (+ (nth 0 ins) (/ bw 2)) (+ (nth 1 ins) (/ bh 2)) (nth 2 ins)) ss1 (ssget "_C" pt1 pt2 '((0 . "line"))) cnt 0 sslen (sslength ss1) ln_ents (list ) ) (command "circle" ins (list (+ (nth 0 ins) (/ bw 2)) (nth 1 ins))) (setq cent (entlast)) (while (< cnt sslen) (setq ln_ents (append ln_ents (list (ssname ss1 cnt))) cnt (1+ cnt) ) ) (command "trim" cent ss1 "" (list (- (nth 0 ins) (- (/ bw 2) 0.01)) (nth 1 ins) 0.0) "") (command "trim" cent ss1 "" (list (+ (nth 0 ins) (- (/ bw 2) 0.01)) (nth 1 ins) 0.0) "") (entdel cent) (setvar "cmdecho" 0) (princ) ) trimlines.dwg Thank you

In Feb fixo helped me to write aSQLCon function. I used the function tooquery SQL databases. I have tried towrite one enabling me to query an access database in the same way. But I am at a total loss. (defun SQLControl ( query_statement / adocmd ADOConn adorst data field fields n sqlQuery tmp data1 data2) ;; Fixo ;; http://www.cadtutor.net/forum/showthread.php?84548-LISP-to-query-MS-SQL-Server-Database-return-results-as-list-of-strings (defun tostring (received / temp ) ; Function Syntax: (tostring received) ; received: Variable to be converted to a string (cond ((= (type received) 'STR) received) ((= (type received) 'INT) (itoa received)) ((= (type received) 'REAL) (rtos received)) ((= (type received) 'LIST) (progn (setq temp "") (foreach listitem received (setq temp (strcat temp " " (datatostring listitem) ) ) ) (setq temp (substr temp 2)) (setq received temp) ) ) ) ) (setq SqlCon "Provider=sqloledb;Data Source=SQL\\DESIGNSQL;Initial Catalog=engineering;user id=DraftingDesign;Password=12345" ADOConn(vlax-create-object "ADODB.Connection") ADORst (vlax-create-object "ADODB.Recordset") data1 (list ) data2 (list ) ) (vlax-invoke-method ADOConn 'Open SqlCon nil "" -1) (setq sqlQuery query_statement ADOcmd (vlax-create-object "ADODB.command") ) (vlax-put-property ADOcmd "ActiveConnection" ADOConn) ; optional ; (vlax-put-property cmd2 "CommandTimeout" 30) (vlax-put-property ADOcmd "CommandText" sqlQuery) (vlax-put-property ADOcmd "CommandType" 1) (setq ADORst(vl-catch-all-apply 'vlax-invoke-method (list ADOcmd 'Execute nil 2 1)));OK (setq fields (vlax-get-property ADORst 'Fields)) (vl-catch-all-apply 'vlax-invoke-method (list ADORst 'movefirst)) (while (not (equal :vlax-true (vlax-get-property ADORst 'eof))) (setq tmp nil n 0) (while (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-get-property (list fields 'item n)))) (setq field (vlax-variant-value (vlax-get-property (vlax-get-property fields 'item n) 'value))) (setq tmp (cons field tmp)) (setq n (1+ n)) ) (setq data (append data (list (reverse tmp)))) (vl-catch-all-apply 'vlax-invoke-method (list ADORst 'movenext))) ; use garbage cleaner before of the closing connection: (gc) (vlax-invoke-method ADOConn 'Close) (vlax-release-object ADORst) (vlax-release-object ADOcmd) (vlax-release-object ADOConn) ; (alert (vl-princ-to-string data)); must use (vl-string-trim " " strvalue) for string values within the data list (foreach line data (foreach item line (setq data1 (append data1 (list (cond ((= item nil)"") ((= (type item) 'SYM)(substr (vl-symbol-name item) 7)) ((/=(type item) 'STR)(tostring item)) (T item) ) ) ) ) ) (setq data2 (append data2 (list data1)) data1 (list ) ) ) data2 )

Hi all, I don't know if this is the appropriate forum, but I was running the VLIDE ide yesterday (ironically whilst on this board looking at some lisp programs), and had to leave my computer for a few hours. When I came back my VLIDE interface won't come up. You can see it on the task bar, but I can't enter anything, and when you use "alt" + "tab" to cycle through the programs, it can't come up. I wonder if there is a setting I may have hit accidentally? Anyways, thanks

(vl-directory-files "C:\\Users\\wpe\\Documents" "*.dwg") Returns a list of DWGs in a folder, but is there to have it return a list of DWGs in the folder and sub-folders?

LISP to query MS SQL Server Database return results as list of strings. (defun getMySqlData ( Name / ) (setq pm Name SQLCon "Server=OurServer;Database=engineering;Trusted_Connection=True" SQLStatement1 "USE enginering SELECT ID FROM Projects WHERE ProjectName = pm" SQLStatement2 "USE enginering SELECT * FROM LineList WHERE ProjectID = ResultsID" ) ; I'm trying to use SQLStatement1 to get the project ID. ; So that I can use it to run this SQLStatement2 ; Then return the results of the above as a list of strings. )

I wrote a sub-routine to update drawing borders. There is a command in CADWorx called IGO which creates isometric drawings. I wanted have this command call my function which updates the borders. But my code doesn't work. (defun c:igo ( / ) (setvar "cmdecho" 0) (command "igo") (setvar "cmdecho" 1) (runisoborderupdate) (princ) )

Greetings my friends. I want to test the compiling in vlisp. I have a lisp file that works, but during the compilation appears the message: "; error: An error has occurred inside the *error* functionAutoCAD variable setting rejected: "cmdecho" nil". Whats the cause of this? Thanks for your help.

I need to create a "pline arc"(Arc option in PLine) and connect a set of blocks. So i m developing a lisp to do it. 1. I get the objects from user using "ssget" 2. I am using COMMAND command to draw PLine arc option to draw pline between the blocks's POSITION property 3. but the COMMAND command has to be closed using [ '') ] 4. But i need to give the next argument iteratively using for loop 5. How to iteratively give the next arguments in COMMAND command THANKS in ADVANCE

Hi everybody, should anyone help me converting this vb code to vlisp? Public Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal Flags As Long) As Long LoadKeyboardLayout "00000409", 1 End Function any help is greatly appreciated