Jump to content

Leaderboard

  1. GLAVCVS

    GLAVCVS

    Community Member


    • Points

      19

    • Posts

      651


  2. BIGAL

    BIGAL

    Trusted Member


    • Points

      8

    • Posts

      19,637


  3. SLW210

    SLW210

    Moderator


    • Points

      4

    • Posts

      11,234


  4. Greenfield

    Greenfield

    New Member


    • Points

      3

    • Posts

      2


Popular Content

Showing content with the highest reputation since 06/24/2025 in all areas

  1. @NanGlase To further assess the possibilities of the "license server" option in real time from AutoCAD, the following needs to be considered: At the code level, you must: Check that both the client PC and your own have the same communication port available, and if not, handle this somehow. Also ensure that the firewall will not block the ports on either the client or the server side. At the infrastructure level, you must: Have a static IP or a domain name on the server side so that your code, when executed by the client, knows where to send the request. In my opinion, although this is an interesting challenge, you should assess whether the effort and investment required are justified by the benefits you may gain. I believe that, considering all of this, the most reasonable options might be those proposed by @Steven P and @BIGAL.
    2 points
  2. Hi everyone, Semi-long time listener, first time caller. I wanted to say thanks for the help and tips I got from this site over the past 6 months. As I have been working on two autolisps, one called P0 the other P9. The do the same thing, kinda. P0 will pull the dwgname field and save it to the clipboard, allowing me to use it wherever without have to flip to the folders . . pick the file . . . hit F2 . . CTRL+C . . . then go back. P9 does the same thing, but adds dwgprefix + dwgname. I work in a third-party firm that uses several client projects with their different CAD standards. Some forbid using fields in the titleblocks for various reasons and like them hard coded. P9 is useful for when I'm jumping between sub-folders and need to plot to source folders. I can't use the PDFExport feature, as different clients use different standards and I need to make sure everything is good before going for each plot, mostly for peace of mind. I wanted to share these with you guys as a thank you and giving back to the community. My autolisps learning is only about 4 - 5 months old. FYI, I didn't know till literally a few days ago, from this very site, that one can right click the tab for the copy full path. lol P9.lsp P0.lsp
    2 points
  3. Hi I’m attaching the code. But first, a brief explanation of how it works. The function is implemented by calling MiGRTexto with one parameter: the desired height for the real-time texts (this should be a value between 0.5 and 1) Therefore, it can be placed inside a main function that can be called from the command line (e.g., (defun c:myCommand)). As for the code that provides functionality, it's actually very simple: it consists of a text next to the right CROSSHAIR and an MTEXT below it. These must be properly managed so that they dynamically update their size, location and content—it's that straightforward. From there, it’s just a matter of adding code to achieve whatever final functionality the user needs. In the attached code, a small emulator for the "pline" command is implemented, triggered by a LEFT CLICK event. This event calls funcionPrincipal, which is provided with two arguments: the screen point indicated and the entity name (or nil) of the object under the PICKBOX at that location. These two arguments should be enough to enable any subsequent operation. It’s important to note that the entire behavior relies on GRREAD, and therefore on mouse and keyboard events. These events are handled using several clauses within a cond expression, which can be extended or modified by the user. I haven’t implemented any code to add object snap functionality. Doing so would considerably complicate the code, and for some users, it may not be necessary. In any case, suggestions and improvements (regarding snapping or any other proposals) are welcome in this thread—for those (myself included) who may want to improve or add new features. I won’t go on any further. Now, the code... ;******************* p o r d e s í a r g o ******************** ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun MiGRTexto (factor / l se e le txTmp txTmp1 txOk tam p pa pt pt1 i? v1 polil alt tx para erroria errores error0 textoGR1 textoGR2 funcionPrincipal) (defun erroria () (defun errores (mens) (setq *error* error0) (vla-delete txTmp) (vla-delete txTmp1) (redraw) (if e (redraw e 4)) (prin1) ) (setq error0 *error* *error* errores ) ) (defun funcionPrincipal (pt e) (setvar 'LASTPOINT pt) ;;;INICIO(START) EMULAD(T)OR "pline" (if polil (entmod (append (entget polil) (list (cons 10 pt)))) (if (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 8 "0") (cons 90 2) '(70 . 128) '(62 . 256) (cons 10 pa) (cons 10 pt) ) ) (setq polil (entlast)) ) ) (setq pa pt) ;;;FIN(END) EMULAD(T)OR "pline" ) (defun textoGR1 () ;THIS FUNCTION RETURN TEXT STRING TO DISPLAY ABOVE CURSOR. ADJUST IT TO SUIT YOUR NEEDS ;ESTA FUNCIÓN DEVUELVE EL TEXTO A MOSTRAR SOBRE EL CURSOR. MIDIFÍCALA SEGÚN LO NECESITES (rtos (distance (getvar 'LASTPOINT) p) 2 3) ) (defun textoGR2 (lp / lp MT) ;ESTA FUNCIÓN DA EL FORMATO NECESARIO AL MTEXT QUE SE MOSTRARÁ BAJO EL CURSOR (foreach l lp (if MT (setq MT (strcat MT (car l) " {\\fLucida Sans Unicode|b0|i0|c0|p34;\\C4;" (cadr l) "}")) (setq MT (strcat (car l) " {\\fLucida Sans Unicode|b0|i0|c0|p34;\\C4;" (cadr l) "}")) ) (setq MT (if (equal l (last lp)) MT (strcat MT "\\P"))) ) ) (defun dameGRT2 (le / cl to) ;THIS FUNCTION RETURN THE LIST OF PAIRS THAT textoGR2 NEEDS TO FORMAT CONTENTS OF MTEXT. ADJUST IT TO SUIT YOUR NEEDS ;ESTA FUNCIÓN DEVUELVE LA LISTA DE PARES QUE NECESITA textoGR2 PARA GENERAR LA CADENA DE TEXTO QUE NECESITA EL MTEXT (list (list "Object" (setq to (cdr (assoc 0 le)))) (list "Layer" (cdr (assoc 8 le))) (list "Color" (if (setq cl (cdr (assoc 62 le))) (itoa cl) "BYLAYER")) (list "XData?" (if (assoc -3 le) "YES" "NO")) ) ) (erroria) (setq txTmp (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) "0" (VLAX-3D-POINT '(0 0)) 0.1) txTmp1 (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point '(0 0)) 5000 "0") i? T ) (vla-put-color txTmp 1) (vla-put-visible txTmp 0) (vla-put-color txTmp1 2) (vla-put-visible txTmp1 0) (while (and (not para) (setq l (grread nil 13 0))) (setq tam (* (getvar "PICKBOX") (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) 2 factor ) ) (if e (redraw e 4)) (setq e (if (setq se (if (listp (setq p (cadr l))) (nentselp p))) (if (and (not (member (vlax-ename->vla-object (car se)) (list txTmp txTmp1))) (member (cdr (assoc 0 (setq le (entget (car se) '("*"))))) '("LWPOLYLINE" "POLYLINE" "LINE" "SHAPE" "3DFACE" "INSERT" "TEXT" "MTEXT" "ATTRIB") ) ) (car se) ) ) ) (if (and i? e) (vla-put-visible txTmp1 1) (vla-put-visible txTmp1 0)) (prompt (strcat "\rLWPOLYLINE mode: " (if pa "next" "first") " point... (Press \'F10\' for " (if i? "DEACTIVATE" "ACTIVATE") " real-time reporting)")) (cond ((= (car l) 5) (if (not v1) (setq v1 (vla-put-visible txTmp 1) v1 T)) (setq pt (list (+ (car p) (* tam 0.8)) (+ (cadr p) (/ tam 2.2)))) (redraw) (if pa (grvecs (list 7 pa p))); THIS LINE IS PART OF THE "pline" EMULATOR CODE. DISABLE IT IF YOU DONT WANT TO USE THE EMULATOR IMPLEMENTED IN funcionPrincipal ; ESTA LINEA FORMA PARTE DEL EMULADOR "pline". DESACTIVALO SI ELIMINAS EL CÓDIGO EMULADOR IMPLEMENTADO EN funcionPrincipal (vlax-put-property txTmp 'InsertionPoint (vlax-make-variant (vlax-3d-point pt))) (vlax-put txTmp 'Height tam) (vlax-put txTmp 'TextString (textoGR1));<<<-- MODIFICAR ESTA LINEA DE CÓDIGO PARA QUE 'TextString MUESTRE EL TEXTO DESEADO (if (and i? e) (progn (redraw e 3) (setq pt1 (list (car pt) (- (cadr p) (/ tam 2.)))) (vlax-put-property txTmp1 'InsertionPoint (vlax-make-variant (vlax-3d-point pt1))) (vlax-put txTmp1 'Height tam) (vlax-put txTmp1 'TextString (textoGR2 (dameGRT2 le))) ) ) ) ((= (car l) 3) (if pa (funcionPrincipal p (car se)) (setq pa p))); ((= (car l) 25) (setq para T)); BOTON DERECHO = SALIR ((member (cadr l) '(67 99)) (if polil (setq para (entmod (subst (cons 70 1) (assoc 70 (entget polil)) (entget polil)))))); ((= (cadr l) 21) (setq i? (not i?))) ;;; AQUI DEBAJO EL CODIGO PARA GESTIONAR EL RESTO DE OPCIONES ;;; BELOW YOU CAN ADD MORE CLAUSES TO 'cond' TO EXTEND THE CODE FUNCTIONALITY (T ;REST OF CASES: WE DO NOTHING ) ;| .... .... |; ) ) (vla-delete txTmp) (vla-delete txTmp1) (redraw) (if e (redraw e 4)) (princ) )
    2 points
  4. This returns the serial number of the motherboard. It is more unique than the hard drive's serial number and also more unique than the variant of this same function that uses "Select * from Win32_BaseBoard". (defun obt_UUID (/ LObj SObj OSObj UUID) (setq LObj (vlax-create-object "WbemScripting.SWbemLocator") SObj (vlax-invoke LObj 'ConnectServer nil nil nil nil nil nil nil nil) OSObj (vlax-invoke SObj 'ExecQuery "SELECT UUID FROM Win32_ComputerSystemProduct") ) (vlax-for Obj OSObj (setq UUID (vlax-get Obj 'UUID)) ) (foreach Obj (list LObj SObj OSObj) (and Obj (vlax-release-object Obj)) ) UUID ) This might be a good option if you want your program to continue working when the user changes their hard drive but not their motherboard.
    2 points
  5. pretty slick! you made a Jig in lisp
    2 points
  6. You can via lisp send yourself an email with the code in it. I would scramble the code. Give client a fas file to run. You can send to a remote server a file, likewise can read a file from a remote server, a bit harder and if your pc is off the code will fail. Have tested this. Re Install from a usb, I had a zip file and a install.lsp, The install lisp unzips all the files to a known directory, yes can unzip a file using lisp, it menuloads the menu and adds support paths. Happy to provide an example. I use this method for multiple users at one company they just email the two files to each user and they drag and drop the lisp. (defun pingserver ( / xml str) (setq server "http://myserver.com.au/TestInfo.txt") ; I would change this to get passed a unique filename (setq xml (vlax-create-object "MSXML2.XMLHTTP.3.0")) (vlax-invoke-method xml 'open "POST" server :vlax-false (vlax-invoke-method xml 'send) (setq str (vlax-get-property xml 'responsetext)) ; got your file !!!!! ;do your bit here )
    1 point
  7. AutoCAD licensing AutoCAD, in real time. Who could resist reading a bit more? Well, yes. Confirmed: this is possible. How? As I said before, through PowerShell (managed from Lisp, of course), but in a more elegant way than using 'sendCommand': with 'setVariable'. The idea is to have our Lisp write a script (.ps1) that creates a lightweight server to listen on a port. AutoCAD PC1 sends a request message to AutoCAD PC2, which processes it and sends a reply back to AutoCAD PC1. Receiving this message triggers the loading of a DCL with a textbox (showing the received code) and an Accept button to register that code. And how do you trigger the DCL upon receiving the message? Think of a detonator: 'setVariable'... and then think of the explosive: 'vlr-sysvar-reactor'. Sounds good? "If you can imagine it, you can build it. And improve it."
    1 point
  8. Sorry even i am away until 9 july. However thanks for your help .
    1 point
  9. @SLW210 Yes, these scripts are LT friendly. Cheers for making Cadtutor a great forum. @Steven P Thank you Steven for your input, I'm eager to give it a try. Over the past few weeks, I couldn't get the v-lax routines to work, I came to the conclusion it was an LT limitation. But your code looks different, I will try yours the next time I'm in the office, which is sometime next week. (Long weekend for me up here in Canada ) In my haste, I made a mistake. The scripts below, Q1 and Q2, just add the dwgname and full path with name to the clipboard respectively that's it. The P0 and P9 do the same but also call the plot dialog box automatically for the user. I won't re-add the P scripts, see above. To verify: Q1 - adds dwgname to the clipboard Q2 - adds dwgprefix + dwgname to the clipboard P0 - adds dwgname to the clipboard and calls the plot dialog P9 - adds dwgprefix + dwgname to the clipboard and calls the plot dialog Have a great weekend. Q1.lsp Q2.lsp
    1 point
  10. Sorry for the delay 'real' work got in the way : ) Dang .. I can't get an animated GIF to load at the moment:
    1 point
  11. Nice. I use these for clipboard, always good to see other ways of doing things. You need both lines for each ;;Copy text to clipboard ;;(vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'setData "TEXT" --MYTEXTSTRING-- ) ;;(vlax-release-object html) ;;and release the object ;;Get text from clipboard ;;(vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'getData "TEXT" ) ;;(vlax-release-object html) ;;and release the object
    1 point
  12. USB: I have the below from RJP. Send an e-mail. There are 2 LISPs below, the first c:sendmail describes the process and the second is a function I call to send e-mails via LISP (usually sending PDFs). Create a little LISP that will return to whatever unique number you want, after that use the below to send you an e-mail with the unique code in - this can be done in the background using Outlook ('send' needs to be 'T'). At your leisure you can put that number into your master LISP, compile it and send the LISP back again for the end user to copy where they want. (rjp-OutlookMessage (<<YOUR-E-MAIL>> "Computer Code" "" <<UNIQUE-CODE>> T) T might need to be "T" Removes the need for you to take the USB to the users desk. ;;http://www.theswamp.org/index.php?topic=26953.msg324794#msg324794 ;;email a file ;;Usage (defun c:sendemail () ; test and example e-mail (rjp-OutlookMessage ;;email address (multiple separated by semicolon) "Some.One@e-mail.com;someone.else@e-mail.com" ;;Subject "Test Email" ;;Attachments as a list of strings '("C:\\Users\\SO123456\\Working Drawings\\ADrawing.pdf") ;;Text in body of email "Nothing to read here :)" ;;nil will open email to edit...T will send email in the background nil ) ) (defun rjp-OutlookMessage (To Subject AttachmentList Body Send / objMail objOL) (if (and (setq objOL (vlax-get-or-create-object "Outlook.Application")) (setq objMail (vlax-invoke-method objOL 'CreateItem 0)) ) (progn (vlax-put objMail 'To To) (vlax-put objMail 'Subject Subject) (vlax-put objMail 'Body Body) (foreach file AttachmentList (vl-catch-all-apply 'vlax-invoke (list (vlax-get objMail 'Attachments) 'Add file ) ) ) (if send (vlax-invoke objMail 'Send) (vlax-invoke objMail 'Display :vlax-true) ) (vlax-release-object objOL) (vlax-release-object objMail) ) ) (princ) ) Second thought for today, how much risk is there to send the LISP out without any protection in the form of computer codes ad so on? For example, all of mine are done on company time, their property and happy to freely share within the company. What I post here I put down to 'learning time' (always learning)... a lot of the users of this thread are the same with little commercial or sensitive info in the LISP... so... what is the risk and do you need to do any more than just compile the code (and even compile the code... do you need to do that)?
    1 point
  13. Autodesk has an Entitlement API if you’re planning on using the app store See Using Entitlement API with Lisp https://adndevblog.typepad.com/autocad/2022/05/using-entitlement-api-with-lisp.html I have a couple of apps there that uses it, it’s pretty cool. Otherwise, it’s not worth spending a lot of time on this, its code that you have to maintain. Keep it simple, something like an XOR cipher and the drive serial is going to be enough. you can store this in the registry or a license file.
    1 point
  14. A lisp version hope fully works in LT. Change the xxx and path etc. (setq *files* (vla-get-files (vla-get-preferences (vlax-get-Acad-object)))) (setq paths (vla-get-SupportPath *files*)) (if (wcmatch paths "*XXX*") (princ) (vla-put-SupportPath *files* (strcat "C:\\XXX-CAD-TOOLS" ";" paths)) ) Copy the 1st two lines to the command line as a test in LT. You should see a list of your support paths C:\\Users\\XXXX\\AppData\\Roaming\\Bricsys\\BricsCAD\\V25x64\\en_US\\Support;D:\\Bricsys\\BricsCAD V24 en_US\\Support; Oh yeah if using Autocad need to add trusted paths, Trusted paths is a bit of why ? As you can set the paths so why have it. (if (> (vl-string-search "BricsCAD" (getvar 'acadver)) 0) (princ "Bricscad") (progn (setq oldtrust (getvar 'trustedpaths)) (if (wcmatch oldtrust "*XXX*") (princ) (setvar 'trustedpaths (strcat oldtrust ";" "c:\\XXX-CAD-TOOLS")) ) ) )
    1 point
  15. wow!! i cut paste that into the search bar and it immediately fired up using my last template ! brilliant i will have a play thank you.
    1 point
  16. And, after a moment of reflection, there's another, less invasive way. I'm just winging it here because I haven't done it before, but I think it should be possible to create an embedded HTTP server in PowerShell. You could write the necessary script to do this from Lisp and run it by calling PowerShell, giving it the necessary instructions to listen to a specific port and call AutoCAD via "sendCommand." But this is such an interesting topic that it might deserve its own thread. I'll leave it for the forum administrators to consider.
    1 point
  17. Thinking a bit about the idea of being able to handle URL requests, it occurs to me that this could be done by creating a command ("c:genKeys", for example) that asks for the number of requests to handle and starts a "while" loop. In this "while" loop, it will look for any changes in a predetermined file (which will be where your remote Lisp writes the hard drive or motherboard ID). For each change it detects, it will subtract 1 from the number of requests you indicated at the beginning, and when that subtraction reaches 0, the command will end. This is the only way I can think of to do this without using a language other than Lisp.
    1 point
  18. All of this must be planned for in your Lisp code. It will only do what you tell it to.
    1 point
  19. Are you talking about turning your AutoCAD installation into a server that handles URL requests? That's not possible with VLisp. With Python, it might be. @Danielm103 might have some interesting suggestions for you. In VLisp, the only possibility would be for your PC — from which you're going to provide the registration code — to run a while loop checking for updates in a predefined file that logs the requests coming from your program on other PCs.
    1 point
  20. Are you talking about turning your AutoCAD installation into a server that handles URL requests? That's not possible with VLisp. With Python, it might be. @DanielM103 might have some interesting suggestions for you. In VLisp, the only possibility would be for your PC — from which you're going to provide the registration code — to run a while loop checking for updates in a predefined file that logs the requests coming from your program on other PCs.
    1 point
  21. Something like this in the acadLTdoc.lsp ;;; acadLTdoc.lsp placed on network folder (setq lispFolder "Z:/Shared/LISP/") ; Change this to your network share path ; Load each LISP file (load (strcat lispFolder "routine1.lsp")) (load (strcat lispFolder "routine2.lsp")) ; Add as needed Then you need to updated each users Support File Search Path and Trusted Folders to include the folder for acadLTdoc.lsp Powershell $baseKey = "HKCU:\Software\Autodesk\AutoCAD LT\R24\ACADLT-1001:409\Profiles\<<Unnamed Profile>>\Preferences" $newPath = "Z:\Shared\CAD\LISP" # Update Support Path $supportPath = Get-ItemProperty -Path $baseKey -Name SupportPath if ($supportPath.SupportPath -notlike "*$newPath*") { $updatedSupport = $supportPath.SupportPath + ";" + $newPath Set-ItemProperty -Path $baseKey -Name SupportPath -Value $updatedSupport } # Update Trusted Paths $trustedPaths = Get-ItemProperty -Path $baseKey -Name TrustedPaths if ($trustedPaths.TrustedPaths -notlike "*$newPath*") { $updatedTrusted = $trustedPaths.TrustedPaths + ";" + $newPath Set-ItemProperty -Path $baseKey -Name TrustedPaths -Value $updatedTrusted } Or You can update profiles. Configure AutoCAD LT on one machine with the correct paths> Export the profile using the OPTIONS > Profiles tab > Export. Distribute the .arg file and use... "C:\Program Files\Autodesk\AutoCAD LT 2024\acadlt.exe" /p "MyCustomProfile.arg" Or If preferred you can go direct to Windows registry. (I believe this is correct, but double check) yor IT should know how to do it. Reg value: SupportPath Type: REG_SZ Reg value: TrustedPaths Type: REG_SZ C:\Program Files\Autodesk\AutoCAD LT 2024\Support;Z:\Shared\CAD\LISP Or update profiles like this. HKEY_CURRENT_USER\Software\Autodesk\AutoCAD LT\R24\ACADLT-<lang_code>:<product_code>\Profiles\<YourProfileName>\Preferences Your IT may have a deployment software, something above should be what they need for that as well.
    1 point
  22. Are you using AutoCAD 2022 as your profile shows?
    1 point
  23. You can also use the line direction left will be -ve right is positive. The way to use this is to pick near an end that implies the direction then do offset point. Here is an example of working out direction. Swaps start & end if required. Then as suggested use the angle of start - end + pi/2. (setq ent (entsel "\nPIck object near end ")) (setq pt (cadr ent)) (setq obj2 (vlax-ename->vla-object (car ent))) (setq start (vlax-curve-getstartPoint obj2)) (setq end (vlax-curve-getendPoint obj2)) (setq d1 (distance pt start)) (setq d2 (distance pt end)) (if (> d1 d2) (setq tmp start start end end tmp )
    1 point
  24. This will write direct to excel dwg names, just pick a dwg in correct directory. Do not have Excel open as it will be opened. Big thanks to Lee Mac for the get dwg names. ; https://www.cadtutor.net/forum/topic/98263-extracting-block-data-to-a-report/page/6/ (defun c:dwgs2excel ( / direc filen files) ;; Directory Files - Lee Mac ;; Retrieves all files of a specified filetype residing in a directory (and subdirectories) ;; dir - [str] Root directory for which to return filenames ;; typ - [str] Optional filetype filter (DOS pattern) *.dwg ;; sub - [bol] If T, subdirectories of the root directory are included ;; Returns: [lst] List of files matching the filetype criteria, else nil if none are found (defun LM:directoryfiles ( dir typ sub ) (setq dir (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir))) (append (mapcar '(lambda ( x ) (strcat dir "\\" x)) (vl-directory-files dir typ 1)) (if sub (apply 'append (mapcar '(lambda ( x ) (if (not (wcmatch x "`.,`.`.")) (LM:directoryfiles (strcat dir "\\" x) typ sub) ) ) (vl-directory-files dir nil -1) ) ) ) ) ) ;; Thanks to fixo ;; ;; = Set Excel cell text = ;; ;; ;; (defun xlsetcelltext ( row column text) (setq cells (vlax-get-property (vlax-get-property myxl "ActiveSheet") "Cells")) (vl-catch-all-apply 'vlax-put-property (list cells 'Item row column (vlax-make-variant (vl-princ-to-string text) vlax-vbstring)) ) ) (setq myxl (vl-catch-all-apply 'vlax-get-or-create-object '("Excel.Application"))) (vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add) (vla-put-visible myXL :vlax-true) (vlax-put-property myxl 'ScreenUpdating :vlax-true) (vlax-put-property myXL 'DisplayAlerts :vlax-true) (setq direc (VL-FILENAME-DIRECTORY (getfiled "Select dwg File for top directory " "" "dwg" 16))) (initget 1 "Yes No") (setq Yesno (getkword "\nDo you want subdirectories [Yes No] ")) (if (= yesno "Yes") (setq files (LM:directoryfiles direc "*.dwg" T)) (setq files (LM:directoryfiles direc "*.dwg" nil)) ) (setq row 0) (foreach filen Files (xlsetcelltext (setq row (1+ row)) 1 filen) ) (princ) )
    1 point
  25. My LISP and ClipIt work on nested blocks. I also noticed that the circle in your example drawing was from AutoCAD Mechanical. If you have something that the LISP isn't working on, please post the drawing here so I can see about a fix. I am doing more work on this, specifically some Labelling options. But for now I just have the tangent lines working and made it an option as well as the single line. Let me know how this version is working. ;;; Creates a circular detail clip from a block reference. Copies, scales, and trims to scaled circle (connected by line(s)). ;;; ;;; https://www.cadtutor.net/forum/topic/98334-detail-circle-in-ms/page/3/#findComment-674386 ;;; ;;;************************************************************************************************| ;;; | ;;; By SLW210 (a.k.a. Steve Wilson) | ;;; | ;;; MSCirClip_1.0.lsp | ;;; | ;;; Uses the Express Tool ClipIt manually (maybe this will be automated at a later time). | ;;; At the prompt-Select the detail circle then select the copied and scaled block. | ;;; At Enter maximum allowable error distance for resolution of arc segments. | ;;; I used 1 and it seems good (smaller is more segments) (see Clipit in Express Tools help). | ;;; | ;;;************************************************************************************************| ;;; ClipIt creates a pseudo circle of polylines, the connector line will most likely have a gap. | ;;; | ;;; Added option to delete the detail circle or keep it. | ;;; | ;;; Added option to use a single connector or two tangent lines | ;;; | ;;; | ;;;************************************************************************************************| ;;;************************************************************************************************| ;;; >>> Lee Mac Trigonometric Functions <<< | ;;; | ;;; Tangent - Lee Mac | ;;; Args: x - real | (defun tan (x) (if (not (equal 0.0 (cos x) 1e-10)) (/ (sin x) (cos x)) ) ) ;;; | ;;; ArcCosine - Lee Mac | ;;; Args: -1 <= x <= 1 | (defun acos (x) (if (<= -1.0 x 1.0) (atan (sqrt (- 1.0 (* x x))) x) ) ) ;;; | ;;;************************************************************************************************| (defun c:MSCIRCLIP (/ ent cen rad newPt scaleFactor newRad scaledBlock detailCircle c1 c2 r1 r2 dx dy d ang3 theta ang1 ang2 t1a t1b t2a t2b lineOption vec len dir pt1 pt2 suffix txtHeight txtPoint txtStr delCircle layerTable detailLayer ) (vl-load-com) (prompt "\n--- MODELSPACE DETAIL VIEW WITH CLIPIT ---\n") ;; Ensure DETAIL layer exists and set current (setq detailLayer "DETAIL") (setq layerTable (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)) ) ) (if (null (tblsearch "LAYER" detailLayer)) (vla-add layerTable detailLayer) ) (setvar 'CLAYER detailLayer) ;; Select block reference (setq ent (car (entsel "\nSelect block reference to detail: "))) (if (not (and ent (= (cdr (assoc 0 (entget ent))) "INSERT"))) (progn (prompt "\nNot a valid block reference.") (exit)) ) ;; Original detail circle (setq cen (getpoint "\nSpecify center of detail circle: ")) (setq rad (getdist cen "\nSpecify radius of detail circle: ")) (entmakex (list '(0 . "CIRCLE") (cons 10 cen) (cons 40 rad) (cons 62 1) (cons 8 detailLayer) ) ) ;; Detail view placement (setq newPt (getpoint "\nSpecify center point for detail view: ")) (initget 7) (setq scaleFactor (getreal "\nEnter detail scale factor (e.g. 2): ")) (setq newRad (* rad scaleFactor)) ;; Copy and scale block (command "COPY" ent "" cen newPt) (setq scaledBlock (entlast)) (command "SCALE" scaledBlock "" newPt scaleFactor) ;; Create clipping circle (temporary) (setq detailCircle (entmakex (list '(0 . "CIRCLE") (cons 10 newPt) (cons 40 newRad) (cons 62 1) (cons 8 detailLayer) ) ) ) ;; Run CLIPIT (prompt "\n>>> Run CLIPIT: Select the detail circle and the new (scaled) block.\n" ) (C:CLIPIT) ;; Connector line (initget "Single Tangents") (setq lineOption (getkword "\nDraw [Single/Tangents] connector line(s)? <Single>: " ) ) (if (null lineOption) (setq lineOption "Single") ) (if (eq lineOption "Single") (progn (setq vec (mapcar '- newPt cen)) (setq len (distance cen newPt)) (setq dir (mapcar '/ vec (list len len len))) (setq pt1 (mapcar '+ cen (mapcar '* dir (list rad rad rad)))) (setq pt2 (mapcar '- newPt (mapcar '* dir (list newRad newRad newRad)) ) ) (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2) (cons 62 3) (cons 8 detailLayer) ) ) ) ;; Tangents (progn (setq c1 cen r1 rad c2 newPt r2 newRad ) (setq dx (- (car c2) (car c1))) (setq dy (- (cadr c2) (cadr c1))) (setq d (sqrt (+ (* dx dx) (* dy dy)))) (if (<= d (abs (- r1 r2))) (prompt "\nCircles too close — no external tangents.\n") (progn (setq ang3 (atan dy dx)) (setq theta (acos (/ (- r1 r2) d))) (setq ang1 (- ang3 theta)) (setq ang2 (+ ang3 theta)) (setq t1a (polar c1 ang1 r1)) (setq t1b (polar c2 ang1 r2)) (setq t2a (polar c1 ang2 r1)) (setq t2b (polar c2 ang2 r2)) (entmakex (list '(0 . "LINE") (cons 10 t1a) (cons 11 t1b) (cons 62 3) (cons 8 detailLayer) ) ) (entmakex (list '(0 . "LINE") (cons 10 t2a) (cons 11 t2b) (cons 62 3) (cons 8 detailLayer) ) ) ) ) ) ) ;; Prompt for deletion (initget "Yes No") (setq delCircle (getkword "\nDelete the scaled detail circle? [Yes/No] <No>: " ) ) (if (eq delCircle "Yes") (progn (if (and detailCircle (entget detailCircle)) (entdel detailCircle) ) ) ) (prompt "\nDetail view created with ClipIt.\n") (princ) )
    1 point
  26. Hello. @Steven P You are/was rigth and my Memory failed, saying that It gave me the same error. It's correct (Estraz_vertici a) And works in the while loop that i made. Also thank you for teaching how to pass a defun result to' another and i ask you how to give more same defun results to another one and different defuns sigle result to another One. Thank you again for tour patience and attention
    1 point
  27. I see that your code doesn't identify the segment selected on the screen. Therefore, I think you should do that little bit of work first (using vlax-curve functions)
    1 point
  28. Hi Nikon The side to offset can be defined by the angle between the first and second points of the segment (+1/2π for the left side or -1/2π for the right side). Therefore, you can obtain the offset point by doing the following: (polar p1 (+/- (angle p1 p2)) (/ PI 2.0)) 1)
    1 point
  29. You mentioned nothing about nested blocks. It worked on your example drawing and mine. I forgot you want 2 tangent lines, I only use a single, maybe I can modify that as an option. I'll look into nested blocks, but I don't think that's going to be easy. Maybe replacing ClipIt with Cookiecutter.
    1 point
  30. @GLAVCVS has mad e a good suggestion, In your check code you can do a IF with a "OR" with the list of keys, or a cond so can have multiple keys but only one program required. In your lisps you just need a (load "mysecuritylisp.lsp) as 1st line it would be set up to auto run. You would give it a name similar to your other lisps so it does not appear to be the check lisp. You can pad it out with junk so long as it has a ";" as 1st character so the lisp file size is not obvious. You only need to run once by checking has it been loaded. (if (not mysecurtiycheck)(load "ASDFGH.lsp")) ; the defun name in the security lisp would be in this case mysecurtiycheck. NO C:.
    1 point
  31. Maybe I finally understood your question: If what you mean is that you were planning to write a unique registration code in your Lisp to register your application on any PC, I don't think it's a good idea. The right thing to do is design an algorithm to generate a key from the serial number of the hard drive or motherboard (whichever you prefer). From that algorithm, you'll need to write a function that converts the serial number into a key. And that key will be the one you'll need to register when you first install your application, and it will be checked every time it's loaded thereafter. Therefore, your algorithm will create a different key for each PC.
    1 point
  32. Ok one of the things you can do is using old fashioned DOS, yes us oldy's know what that is, but you can write one checkuser.lsp program that has the hidden code in it. Ok from windows cmd you can run a bat file, yeah old DOS. Repeat for every lisp. Copy checkuser.lsp+mylispprogram1.lsp c:/compile/mylispprogram.lsp You do this in a bat file for every lisp program so it appends your check code to your lisp programs. Saving as a copy is a good idea. You can then use this to make FAS files of the new lisp. ; must have vlide open to work (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "Vlide") (setq loads (list ""xxx3d pts on face 4" "xxxblock atts invisible" "xxxChange client logos-3" "xxxClose plines" "xxxCogo Label_C" ) ) (setq loc1 "C:\\XXX-CAD-TOOLS\\") ;;change dirs to where ever you want them found (setq loc2 "D:\\XXX\\compile\\") ;;change dirs to where ever you want them saved (foreach lisp loads (vlisp-compile 'st (strcat loc1 lisp ".lsp") (strcat loc2 lisp ".fas")) )
    1 point
  33. This will get around any value you want even "ZZ" just note "A" is 1 posted both conversions. ; Alpha2Number - Converts Alpha string into Number ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Str$ = String to convert ; Syntax example: (Alpha2Number "ABC") = 731 ;------------------------------------------------------------------------------- (defun Alpha2Number (Str$ / Num#) (if (= 0 (setq Num# (strlen Str$))) 0 (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#))) (Alpha2Number (substr Str$ 2)) ) ) ) ;------------------------------------------------------------------------------- ; Number2Alpha - Converts Number into Alpha string ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Num# = Number to convert ; Syntax example: (Number2Alpha 731) = "ABC" ;------------------------------------------------------------------------------- (defun Number2Alpha (Num# / Val#) (if (< Num# 27) (chr (+ 64 Num#)) (if (= 0 (setq Val# (rem Num# 26))) (strcat (Number2Alpha (1- (/ Num# 26))) "Z") (strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#))) ) ) );defun Number2Alpha Providing you dont exceed "Z" then you can use (chr x) where (chr 65) is "A" 66 is "B" and so on.
    1 point
  34. Trimming out side use Extrim inside it is (etrim obj pt) just load it 1st that exposes the Etrim defun. Use (getvar 'extmax) for pt. In my Bricscad it odes not work properly hence why in code above use Cookiecutter. Sent a support request to Bricsys for comment. Just copying the objects trim them, then rescale is much easier than making a block of objects. Pick circle, enter desired scale, go to a layout and make correct viewport at desired scale a much better way.
    1 point
  35. I don't think I understand exactly what you mean. Can you explain that a little more?
    1 point
  36. But if the registration code is invalid, all symbols created during application loading must be set to 'nil'.
    1 point
  37. Hi I suppose you should compile the code. Do you have functions to obtain hardware serial numbers? If so, one implementation of the code could be to group the payment functions under a main function that only runs if a key you created exists in the Windows registry. Your code should create that key when the user enters a valid registration code. Another option is to save the registration code in a file. Or in both. If, when your application loads, it finds the key and it's correct, then it would load the defun with all the protected code.
    1 point
  38. After seeing @BIGAL's suggestion, I'm wondering if I understood correctly what you're asking, Vica. Anyway, I'm attaching a short clip of what I'm talking about. FACTVM de ARCTIS.mp4 I’ve implemented a small emulator of the "pline" command in the base code, but each user should implement the code they need for their specific task instead. Basically, the distance variation from the last stored point in LASTPOINT is displayed above the cursor (though this can be easily changed by modifying the textoGR1 function). Below the cursor, any desired information about the object under it will be shown (or not, if visibility is toggled by pressing the F10 key). This information must be passed to the textoGR2 function as a list of (Property_Name StringValue) pairs. The main code must be implemented in the 'FuncionPrincipal' function.
    1 point
  39. The only reliable way I know to align the stretch box is to turn the model by changing the UCS. Use the PLAN command to redraw the model in the current UCS. There's probably a way to do that without a Zoom Extents in the bargain (Dview Twist?). When you're through, change the UCS back to World and run PLAN again. A bit of research says Dview may turn the camera without changing the UCS. Even better. You can change back to the normal view when you finish your stretch, no UCS change or PLAN necessary.
    1 point
×
×
  • Create New...