Jump to content

Search the Community

Showing results for tags 'lee mac'.

  • Search By Tags

    Type tags separated by commas.
  • Search By Author

Content Type


Forums

  • CADTutor
    • News, Announcements & FAQ
    • Feedback
  • AutoCAD
    • AutoCAD Beginners' Area
    • AutoCAD 2D Drafting, Object Properties & Interface
    • AutoCAD Drawing Management & Output
    • AutoCAD 3D Modelling & Rendering
    • AutoCAD Vertical Products
    • AutoCAD LT
    • CAD Management
    • AutoCAD Bugs, Error Messages & Quirks
    • AutoCAD General
    • AutoCAD Blogs
  • AutoCAD Customization
    • The CUI, Hatches, Linetypes, Scripts & Macros
    • AutoLISP, Visual LISP & DCL
    • .NET, ObjectARX & VBA
    • Application Beta Testing
    • Application Archive
  • Other Autodesk Products
    • Autodesk 3ds Max
    • Autodesk Revit
    • Autodesk Inventor
    • Autodesk Software General
  • Other CAD Products
    • BricsCAD
    • SketchUp
    • Rhino
    • SolidWorks
    • MicroStation
    • Design Software
    • Catch All
  • Resources
    • Tutorials & Tips'n'Tricks
    • AutoCAD Museum
    • Blocks, Images, Models & Materials
    • Useful Links
  • Community
    • Introduce Yourself
    • Showcase
    • Work In Progress
    • Jobs & Training
    • Chat
    • Competitions

Categories

  • Programs and Scripts
  • 2D AutoCAD Blocks
  • 3D AutoCAD Blocks
  • Images
    • Backgrounds

Find results in...

Find results that contain...


Date Created

  • Start

    End


Last Updated

  • Start

    End


Filter by number of...

  1. So I have been trying to figure this out with several approaches now and I need some help. I would like to send all Wipeouts, or really any specified entity type, within a block to the back of the draw order. Is there a way to do this using Lee Mac's Apply To Block Objects routine? I tried this in conjunction with his draw order routines but the MovetoBottom command kept failing. I'm pretty rough with VisualLisp which is part of the issue when trying to troubleshoot his great routines. Or what about this approach? (I dont really understand it, again Visual Lisp) Below is what I tried. I do understand Vanilla Lisp. Visual Lisp I barely know the basics, but eager to learn. Please help me improve my capabilities. I love autolisp. Thank you. The issue is clearly with the lambda function and my improper use of it Im sure. The ssget I am trying to do is incorrect approach for use with his function. ;=========================================================== ; 11/Sep/2020 10:09 AM[Friday] AUTHOR: Brandon Gum ;-- ;DESCRIPTION: ;Select block with wipeout. ;Will send wipeout objects the back of the draw orer ;=========================================================== (defun c:test ( / s ) (princ "\nSelect Block: ") (if (setq s (ssget "_+.:E:S" '((0 . "INSERT")))) (LM:ApplytoBlockObjects (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-effectivename (vlax-ename->vla-object (ssname s 0))) '(lambda ( obj ) (BG:WipeoutToBottom)) ) ) (princ) ) (vl-load-com) (princ) (defun BG:WipeoutToBottom( / ) (LM:movetobottom (ssget "X" '((0 . "WIPEOUT")))) ;(princ) );end of defun ;===============Below here are Lee's draw order functions============== My LeeMac Based Approach.LSP
  2. Hi every one, I am jonir an electrical engineer. I have a small idea that I like to implement .. I need a lot to calculate the length of a polyline or line that represents In my work the power consumtion next step, I calculate how meny loads on it on exel sheet and then the output is the value of the voltage drop by this equation ( 24 - I*(R/Length)* Length from drawing) 24 : Constant voltege I : sumition carrunt from different loads I choose it. R/Length : constant L: length of line or polyline from drawing. Is that possible by lisp? Best regards,
  3. Is there a possibility to get lisp for block counter an total length for all line and polyline in one command ? ( export data to table ) Any ideas for merging the two lispes i attached files? CountV1-5.lsp Totallenght.lsp
  4. I have autolisp program but when I run this program error "error: no function definition: GETEXCEL" are arrived. i also used this extension program but error is still there "http://web2.airmail.net/terrycad/LISP/GetExcel.lsp" so please help to remove this error...
  5. defun C:CR (/ PNT1 P1X P1Y STDY DY COORD PTXT) (defun *error* ( m ) (princ m) (redraw) (princ)) (while (= 5 (car (setq pnt (grread nil 13 0)))) (redraw) (setq str (mapcar 'rtos (trans (cadr pnt) 1 0))) (LM:DisplayGrText (cadr pnt) (LM:GrText (strcat "E " (car str) "\nN " (cadr str))) 3 15 -31) ) (redraw) (setq str1 (reverse (cdr (reverse str)))) (setq COORD(strcat "E " (car str)) COORD1(strcat "N " (cadr str))) (command "LEADER" (cadr pnt) PAUSE "" COORD COORD1 "" "") (princ)) ; end (princ "\n E,N CO-ORDINATES OF A POINT - Type \"CR\" to start") when i use this i cant get the snap how can i get snap with this???? http://www.lee-mac.com/grtext.html
  6. I want any explain how to use "Automatically Label Attributes" LiSP, i need steps how to add serial number on pipes this LISP from LEE MAC.
  7. Hey Guys! I found an awesome lisp file for my work(Lee Mac's Text calculator) and i started using it.It adds numerical text and place the result.But my cad project consists many numbers and I can't separate the selected number from the unselected one.Can any one update it to change the color after the text is selected. please It's urgent!!! TextCalc.lsp
  8. Hi Please could someone assist with modifying an existing routine that moves a nested entity (NestedMoveV1-2.lsp by Lee Mac). This is an awesome routine, and I have looked into the code, but unfortunately I am still too new to LISP to make any progress. If someone could perhaps show me how to modify the routine to do the following , I would really appreciate it: 1. Enable the entity being moved to be visually "dragged" with the cursor (perhaps this has somehting to to with DRAGMODE system variable?) - this would enable me to accurately place the entity in the new position while taking into account any adjacent objects in the drawing. 2. Is it possible to have this work with dynamic blocks as well? Looking forward to your replies NestedMoveV1-2.lsp
  9. Hi All Members Please Please help me for text on Polyline with block Sorry for English S2_A1_CS_LIST_FINAL.dwg
  10. Hi everyone, I am using Lee Mac's Program BrowseForFolderV1-3.lsp (http://www.lee-mac.com/directorydialog.html) to save and open folder's contents in a DCL box. I have set the value for the bit Parameter to 16384: (GetFiles:browseforfolder "" "" 16384). In this way, when I am exploring the folders, I can see that there are .lnk folders, but I don't achieve to open the .lnk folders and see/save their content. Does anybody know if I need to use another bit parameter combination or do I have to modify the "browseforfolder" function to accomplish my task? Please find attached a Screenshoot of my DCL box. When I click the "Pfad auswählen" Button I have the option to load the selected folder's content from the next window folder explorer. I can open/select a normal folder to see for example all .dwgs that are saved inside that folder. But I can't open a linked folder. Please see the red arrow in the attached Screen Shoot. Please help with ideas! Many thanks in advance. (defun LM:browseforfolder ( msg dir flg / err fld pth shl slf ) (setq err (vl-catch-all-apply (function (lambda ( / app hwd ) (if (setq app (vlax-get-acad-object) shl (vla-getinterfaceobject app "shell.application") hwd (vl-catch-all-apply 'vla-get-hwnd (list app)) fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg flg dir) ) (setq slf (vlax-get-property fld 'self) pth (GetFiles:fixdir (vlax-get-property slf 'path)) ) ) ) ) ) ) (if slf (vlax-release-object slf)) (if fld (vlax-release-object fld)) (if shl (vlax-release-object shl)) (if (vl-catch-all-error-p err) (prompt (vl-catch-all-error-message err)) pth ) )
  11. All, I was wondering if anyone else was having a problem using Lee Mac's "Add to Block " on a dynamic block? Recently our title blocks have changed over to dynamic and now I cant use "Add to block" anymore. Thanks, Brian
  12. All, I've been using Lee Mac's "Add object to block" lisp for sometime now and it works great, and one of the things I use it for is my title block for revisions but now the revision block has been inserted into the title block as a block and it won't add what I want to the revision block. Is there a way to make it find the revision block inside of the title block? Basically I would to able to pick the block inside of a block. ;;----------------=={ Add Objects to Block }==----------------;; ;; ;; ;; Adds all objects in the provided SelectionSet to the ;; ;; definition of the specified block. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; doc - Document Object in which block resides. ;; ;; block - Entity name of reference insert ;; ;; ss - SelectionSet of objects to add to definition ;; ;;------------------------------------------------------------;; (defun LM:AddObjectstoBlock ( doc block ss / lst mat ) (setq lst (LM:ss->vla ss) mat (LM:Ref->Def block) mat (vlax-tmatrix (append (mapcar 'append (car mat) (mapcar 'list (cadr mat))) '((0. 0. 0. 1.)))) ) (foreach obj lst (vla-transformby obj mat)) (vla-CopyObjects doc (LM:SafearrayVariant vlax-vbobject lst) (vla-item (vla-get-Blocks doc) (cdr (assoc 2 (entget block)))) ) (foreach obj lst (vla-delete obj)) (vla-regen doc acAllViewports) ) ;;-----------------=={ Remove From Block }==------------------;; ;; ;; ;; Removes an Entity from a Block Definition ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; ent - Entity name of Object to Delete from Block [ENAME] ;; ;;------------------------------------------------------------;; (defun LM:RemovefromBlock ( doc ent ) (vla-delete (vlax-ename->vla-object ent)) (vla-regen doc acAllViewports) (princ) ) ;;------------------=={ Safearray Variant }==-----------------;; ;; ;; ;; Creates a populated Safearray Variant of a specified ;; ;; data type ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; datatype - variant type enum (eg vlax-vbDouble) ;; ;; data - list of static type data ;; ;;------------------------------------------------------------;; ;; Returns: VLA Variant Object of type specified ;; ;;------------------------------------------------------------;; (defun LM:SafearrayVariant ( datatype data ) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray datatype (cons 0 (1- (length data)))) data ) ) ) ;;------------=={ SelectionSet -> VLA Objects }==-------------;; ;; ;; ;; Converts a SelectionSet to a list of VLA Objects ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; ss - Valid SelectionSet (Pickset) ;; ;;------------------------------------------------------------;; ;; Returns: List of VLA Objects, else nil ;; ;;------------------------------------------------------------;; (defun LM:ss->vla ( ss / i l ) (if ss (repeat (setq i (sslength ss)) (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l)) ) ) ) ;;---------------=={ Block Ref -> Block Def }==---------------;; ;; ;; ;; Returns the Transformation Matrix and Translation Vector ;; ;; for transforming Block Reference Geometry to the Block ;; ;; Definiton. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; e - Block Reference Entity ;; ;;------------------------------------------------------------;; ;; Returns: List of 3x3 Transformation Matrix, Vector ;; ;;------------------------------------------------------------;; (defun LM:Ref->Def ( e / _dxf a l n ) (defun _dxf ( x l ) (cdr (assoc x l))) (setq l (entget e) a (- (_dxf 50 l)) n (_dxf 210 l)) ( (lambda ( m ) (list m (mapcar '- (_dxf 10 (tblsearch "BLOCK" (_dxf 2 l))) (mxv m (trans (_dxf 10 l) n 0) ) ) ) ) (mxm (list (list (/ 1. (_dxf 41 l)) 0. 0.) (list 0. (/ 1. (_dxf 42 l)) 0.) (list 0. 0. (/ 1. (_dxf 43 l))) ) (mxm (list (list (cos a) (sin (- a)) 0.) (list (sin a) (cos a) 0.) (list 0. 0. 1.) ) (mapcar '(lambda ( e ) (trans e n 0 t)) '( (1. 0. 0.) (0. 1. 0.) (0. 0. 1.) ) ) ) ) ) ) ;; Matrix x Vector - Vladimir Nesterovsky (defun mxv ( m v ) (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) ) ;; Matrix x Matrix - Vladimir Nesterovsky (defun mxm ( m q ) (mapcar (function (lambda ( r ) (mxv (trp q) r))) m) ) ;; Matrix Transpose - Doug Wilson (defun trp ( m ) (apply 'mapcar (cons 'list m)) ) ;;---------------------=={ Select if }==----------------------;; ;; ;; ;; Provides continuous selection prompts until either a ;; ;; predicate function is validated or a keyword is supplied. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; msg - prompt string ;; ;; pred - optional predicate function [selection list arg] ;; ;; func - selection function to invoke ;; ;; keyw - optional initget argument list ;; ;;------------------------------------------------------------;; ;; Returns: Entity selection list, keyword, or nil ;; ;;------------------------------------------------------------;; (defun LM:SelectIf ( msg pred func keyw / sel ) (setq pred (eval pred)) (while (progn (setvar 'ERRNO 0) (if keyw (apply 'initget keyw)) (setq sel (func msg)) (cond ( (= 7 (getvar 'ERRNO)) (princ "\nMissed, Try again.") ) ( (eq 'STR (type sel)) nil ) ( (vl-consp sel) (if (and pred (not (pred sel))) (princ "\nInvalid Object Selected.") ) ) ) ) ) sel ) ;-------------------------------------------------------------; ; -- Test Functions -- ; ;-------------------------------------------------------------; (defun c:Add2Block ( / *error* _StartUndo _EndUndo acdoc ss e ) (defun *error* ( msg ) (if acdoc (_EndUndo acdoc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (defun _StartUndo ( doc ) (_EndUndo doc) (vla-StartUndoMark doc) ) (defun _EndUndo ( doc ) (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndoMark doc) ) ) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (if (and (setq ss (ssget "_:L")) (setq e (LM:SelectIf "\nSelect Block to Add Objects to: " '(lambda ( x ) (eq "INSERT" (cdr (assoc 0 (entget (car x)))))) entsel nil ) ) ) (progn (_StartUndo acdoc) (LM:AddObjectstoBlock acdoc (car e) ss) (_EndUndo acdoc) ) ) (princ) ) ;-------------------------------------------------------------; (defun c:Remove ( / *error* _StartUndo _EndUndo acdoc e ) (defun *error* ( msg ) (if acdoc (_EndUndo acdoc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (defun _StartUndo ( doc ) (_EndUndo doc) (vla-StartUndoMark doc) ) (defun _EndUndo ( doc ) (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndoMark doc) ) ) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (while (setq e (car (nentsel "\nSelect Object to Remove: "))) (_StartUndo acdoc) (LM:RemovefromBlock acdoc e) (_EndUndo acdoc) ) (princ) ) (vl-load-com) (princ) ;;------------------------------------------------------------;; ;; End of File ;; ;;------------------------------------------------------------;;
  13. Hello all. First off let me thank Lee Mac for all that he does with LISP and how he helps others out. He is a great value to the community. Now for the question I have been trying to get his Tip of the day lisp working. I have the lisp in my startup suite, it and the text file are both in a support file search path, and it does not show a tip at the start of the day. The Lisp does load because I can type (LM:tip) and it shows a tip, it just does not show anything for the first dwg of the day. Could the issue be that I am using Civil 3D 2015, maybe so variable that is causing the problem? http://www.lee-mac.com/tipoftheday.html
  14. Hey guys, So thanks to Lee Mac, I've got this stellar labeling LISP that works for a variety of situations. I need help throwing one more situation into the mix. I'd like it to have different behavior when labeling the block named "Symbol - Tree CRZ". Within this block, there is a User Parameter called "PercentImpacted" that uses an expression based on other user parameters to return a specific value. For this block, I need the leader text to say: "[Value from PercentImpacted parameter to 1 decimal place] + "% CRZ" Ex: I'd like the leader to work how the hatch component of the LISP works, wherein it asks for the user to specify the arrowhead location, rather than auto-starting at the block insertion point. And it should still allow for pickfirst action like the block labeling component does. Mega bonus points if there's a way to make the value in the leader a field that would update if the value of the user parameter changed. If pulling data directly from user parameters like this isn't possible, I can add an attribute that pulls the value from the parameter, and then the label could pull from the attribute. And commented code would would be awesome so I can unravel what does what. Trying to learn, slowly...
  15. I have two Lisp Programmes with me, One of those LISP is downloaded from LEEMAC 1st Lisp gives the hatch area as text in AutoCAD drawing 1 - Areas2FieldV1-3.lsp 2nd Lisp gives an output as .txt file when you click two text objects in the drawing 2 - 2str.lsp I want to combine those 2 lisp programmes into one. Expecting output : Every hatch has individual survey numbers, by selecting the survey number & respective hatch, Result should be survey Number, Hatch Area. Is it Possible ?? Very Very Urgent for me.:(
  16. Hey guys! So the amazing Lee Mac wrote two different versions of a LISP based on a request I posted. Workflow demands have changed and now I need to modify the lisp to be somewhere in between the two versions. Version 1 & Version 2. For the combo lisp, I need: The block multileader to populate from the block's description, rather than name (like it does in Version 1). If there is no description, then the contents should default on block name (not from either version, but it would be helpful. I'm not sure how tricky it would be to code) The block multileader to automatically start at the block's insertion point (like it does in Version 2). The hatch multileader component is perfect in both versions (pulling the name and prompting for first click as insertion point) I tried fiddling around with it, but am too much of a noob to really make heads or tails of what's going on between the two versions (to my amateur eyes, the methods used between the two are too different for me to reconcile). Thanks for any help!
  17. Hi Lee, been using this code in daily basis, Just a quick question. Would it be possible to add "plot to PDF" after it changes the attribute values? http://www.lee-mac.com/batte.html
  18. DesmetMartin

    Layer Lisp Question

    I have a Lisp from Lee Mac which I would like to be modified. I would like to have a setting that let's you choose which layer it should be on. I have tried to write something myself and only came up with this: ****************************************************************** (setq TASH (getint "\nChoose dimensions layer: Dim. (1), Front view (2)")) ); end while ); progn );TASH = 1, Dim (if (= TASH 1 ) (progn ; S-Dimensions (command "DIM*" "S-DIMENSIONS" "Dimension Layer" 3 "Continuous" -3 1 nil ) ); progn ); if (= TAMR 1) ****************************************************************** and: ****************************************************************** (defun CommandReactor:CommandWillStart (rea cmd) (if (wcmatch (strcase (car cmd)) "*DIM*") (progn (setq *OldClayer* (getvar 'clayer)) (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (setq TASH (getint "\nChoose dimensions layer: Dim. (1), Front view (2)")) ); end while (setvar 'clayer layerName) ) ) ) ****************************************************************** But I don't know were to put it in the existing lips from Lee Mac. Can anyone help? The lisp from Lee Mac is now; ****************************************************************** http://lee-mac.com/lisp/html/LayerDirectorV1-4.html ****************************************************************** Thanks!! Ps. Check out Lee Mac's lisps!
  19. hello sir, I have a selection set consists of number of ellipse I want to get center point, minor width and major width of each ellipse and stored in excel file. please help regarding this.....
  20. i want to extract all coordinate and dimension from AutoCAD drawing(attached file) i am using below code they extract only circle dimension, what can i do to extract other dimension.. (vl-load-com) (defun c:test (/ i e p1 p2 ss lst q var f fn dat dat1) ;hanhphuc 2014 (set 'var (getvar 'cmdecho )) (setvar 'cmdecho 0) (if (and (setq e (entsel "\nPlease select solid.. ")) (setq e (car e)) (= (cdr (assoc 0 (entget e))) "3DSOLID")) (progn (vla-GetBoundingBox (setq obj (vlax-ename->vla-object e)) 'p1 'p2) (mapcar ''((a b) (set a (vlax-safearray->list b))) '(p1 p2) (list p1 p2)) (command "_explode" e) (setq i 0 ss (ssget "C" p1 p2) lst (mapcar '(lambda(x) (setq q nil) (if (= (cdr (assoc 0 (entget x))) "REGION") (setq q (cons (LM:reg x) q)) (setq q (cons (vlax-ename->vla-object x) q)) ) (if (listp q) (LM:flatten q) q ) ) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ) ;_ end of mapcar ) ;_ end of setq (foreach o (vl-remove-if-not ''((x) (= (vla-get-ObjectName x) "AcDbCircle")) (LM:flatten lst)) (setq dat(cons (princ (strcat "\nCIRCLE_" (itoa (setq i (1+ i))) " " (vl-princ-to-string (mapcar ''((x)(vlax-get o x)) '(Radius Center)) ))) dat)) ) ;_ end of foreach (command "_.U") (setq fn (strcat (getvar "dwgprefix") "hole dat.csv") f (open fn "w")) ; If you don't want to override file ,to append use (open fn "a") as suggested by Marko @ post#14 (foreach $ (foreach x dat (setq dat1 (cons (vl-string-translate " " "," (vl-list->string (vl-remove-if ''((a) (or (= a 10) (= a 40) (= a 41))) (vl-string->list x)) ) ;_ end of vl-list->string ) ;_ end of vl-string-translate dat1 ) ;_ end of cons ) ;_ end of setq ) ;_ end of foreach (write-line $ f)) (write-line " " f) (if f (close f)) (startapp "notepad" fn) ; ) ;_ end of progn ) ;_ end of if (setvar 'cmdecho var) (princ) ) ;_ end of defun ;;;http://www.cadtutor.net/forum/showthread.php?35506-How-to-get-Region-coordinates/page2 ;;;adopted as sub-function (defun LM:reg (reg / RetObj) (setq Reg (vlax-ename->vla-object reg)) (if (vlax-method-applicable-p reg 'explode) (progn (setq RetObj (vlax-safearray->list (vlax-variant-value (vla-explode Reg)))) (repeat (length RetObj) (if (eq "AcDbRegion" (vla-get-ObjectName (car RetObj))) (setq RetObj (append RetObj (vlax-safearray->list (vlax-variant-value (vla-explode (car RetObj)))))) (setq RetObj (append RetObj (list (car RetObj)))) ) ;_ end of if (setq RetObj (cdr RetObj)) ) ;_ end of repeat ) ) retobj ) ;_ end of defun ;; Flatten List - Lee Mac ;; Transforms a nested list into a non-nested list ;; http://www.lee-mac.com/flatten.html (defun LM:flatten ( l ) (if (atom l) (list l) (append (LM:flatten (car l)) (if (cdr l) (LM:flatten (cdr l)))) ) )
  21. i have a 3D object in autocad and i want to create selection set of line, circle, arc, polyline of that object using visual lisp. please help.. thanks in advance... Drawing1.dwg
  22. i need help to extract length, width and thickness from 3-D constant thickness object using visual lisp... and showing this L, B & T value in file...
  23. I'm trying to get LISP to automate the editing of a bunch of dynamic blocks for basic things like width and depth. I want to have all these values set up by model numbers in in an Excel spreadsheet. In order to accomplish this, I've used the code for "Set Dynamic Property Value" by Lee Mac and "GetExcel" by Terry Miller (thank you both so much for getting me this far). I have succeeded in getting LISP to manipulate dynamic blocks with Lee Mac's code, but only using hard numbers. I can also get Getexcel to return numbers from my .xls. But I can't get those Excel numbers into the dynamic block values. Here's how the code I came up with looks (the part that I wrote is at the bottom and is my attempt to get all the stuff above to work together): ;------------------------------------------------------------------------------- ; Program Name: GetExcel.lsp [GetExcel R4] ; Created By: Terry Miller (Email: [email="terrycadd@yahoo.com"]terrycadd@yahoo.com[/email]) ; (URL: [url]http://web2.airmail.net/terrycad[/url]) ; Date Created: 9-20-03 ; Function: Several functions to get and put values into Excel cells. ;------------------------------------------------------------------------------- ; Revision History ; Rev By Date Description ;------------------------------------------------------------------------------- ; 1 TM 9-20-03 Initial version ; 2 TM 8-20-07 Rewrote GetExcel.lsp and added several new sub-functions ; including ColumnRow, Alpha2Number and Number2Alpha written ; by Gilles Chanteau from Marseille, France. ; 3 TM 12-1-07 Added several sub-functions written by Gilles Chanteau ; including Cell-p, Row+n, and Column+n. Also added his ; revision of the PutCell function. ; 4 GC 9-20-08 Revised the GetExcel argument MaxRange$ to accept a nil ; and get the current region from cell A1. ;------------------------------------------------------------------------------- ; Overview of Main functions ;------------------------------------------------------------------------------- ; GetExcel - Stores the values from an Excel spreadsheet into *ExcelData@ list ; Syntax: (GetExcel ExcelFile$ SheetName$ MaxRange$) ; Example: (GetExcel "C:\\Folder\\Filename.xls" "Sheet1" "L30") ; GetCell - Returns the cell value from the *ExcelData@ list ; Syntax: (GetCell Cell$) ; Example: (GetCell "H15") ; Function example of usage: ; (defun c:Get-Example () ; (GetExcel "C:\\Folder\\Filename.xls" "Sheet1" "L30");<-- Edit Filename.xls ; (GetCell "H21");Or you can just use the global *ExcelData@ list ; );defun ;------------------------------------------------------------------------------- ; OpenExcel - Opens an Excel spreadsheet ; Syntax: (OpenExcel ExcelFile$ SheetName$ Visible) ; Example: (OpenExcel "C:\\Folder\\Filename.xls" "Sheet1" nil) ; PutCell - Put values into Excel cells ; Syntax: (PutCell StartCell$ Data$) or (PutCell StartCell$ DataList@) ; Example: (PutCell "A1" (list "GP093" 58.5 17 "Base" "3'-6 1/4\"")) ; CloseExcel - Closes Excel session ; Syntax: (CloseExcel ExcelFile$) ; Example: (CloseExcel "C:\\Folder\\Filename.xls") ; Function example of usage: ; (defun c:Put-Example () ; (OpenExcel "C:\\Folder\\Filename.xls" "Sheet1" nil);<-- Edit Filename.xls ; (PutCell "A1" (list "GP093" 58.5 17 "Base" "3'-6 1/4\""));Repeat as required ; (CloseExcel "C:\\Folder\\Filename.xls");<-- Edit Filename.xls ; (princ) ; );defun ;------------------------------------------------------------------------------- ; Note: Review the conditions of each argument in the function headings ;------------------------------------------------------------------------------- ; GetExcel - Stores the values from an Excel spreadsheet into *ExcelData@ list ; Arguments: 3 ; ExcelFile$ = Path and filename ; SheetName$ = Sheet name or nil for not specified ; MaxRange$ = Maximum cell ID range to include or nil to get the current region from cell A1 ; Syntax examples: ; (GetExcel "C:\\Temp\\Temp.xls" "Sheet1" "E19") = Open C:\Temp\Temp.xls on Sheet1 and read up to cell E19 ; (GetExcel "C:\\Temp\\Temp.xls" nil "XYZ123") = Open C:\Temp\Temp.xls on current sheet and read up to cell XYZ123 ;------------------------------------------------------------------------------- (defun GetExcel (ExcelFile$ SheetName$ MaxRange$ / Column# ColumnRow@ Data@ ExcelRange^ ExcelValue ExcelValue ExcelVariant^ MaxColumn# MaxRow# Range$ Row# Worksheet) (if (= (type ExcelFile$) 'STR) (if (not (findfile ExcelFile$)) (progn (alert (strcat "Excel file " ExcelFile$ " not found.")) (exit) );progn );if (progn (alert "Excel file not specified.") (exit) );progn );if (gc) (if (setq *ExcelApp% (vlax-get-object "Excel.Application")) (progn (alert "Close all Excel spreadsheets to continue!") (vlax-release-object *ExcelApp%)(gc) );progn );if (setq ExcelFile$ (findfile ExcelFile$)) (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application")) (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$) (if SheetName$ (vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets") (if (= (vlax-get-property Worksheet "Name") SheetName$) (vlax-invoke-method Worksheet "Activate") );if );vlax-for );if (if MaxRange$ (progn (setq ColumnRow@ (ColumnRow MaxRange$)) (setq MaxColumn# (nth 0 ColumnRow@)) (setq MaxRow# (nth 1 ColumnRow@)) );progn (progn (setq CurRegion (vlax-get-property (vlax-get-property (vlax-get-property *ExcelApp% "ActiveSheet") "Range" "A1") "CurrentRegion") );setq (setq MaxRow# (vlax-get-property (vlax-get-property CurRegion "Rows") "Count")) (setq MaxColumn# (vlax-get-property (vlax-get-property CurRegion "Columns") "Count")) );progn );if (setq *ExcelData@ nil) (setq Row# 1) (repeat MaxRow# (setq Data@ nil) (setq Column# 1) (repeat MaxColumn# (setq Range$ (strcat (Number2Alpha Column#)(itoa Row#))) (setq ExcelRange^ (vlax-get-property *ExcelApp% "Range" Range$)) (setq ExcelVariant^ (vlax-get-property ExcelRange^ 'Value)) (setq ExcelValue (vlax-variant-value ExcelVariant^)) (setq ExcelValue (cond ((= (type ExcelValue) 'INT) (itoa ExcelValue)) ((= (type ExcelValue) 'REAL) (rtosr ExcelValue)) ((= (type ExcelValue) 'STR) (vl-string-trim " " ExcelValue)) ((/= (type ExcelValue) 'STR) "") );cond );setq (setq Data@ (append Data@ (list ExcelValue))) (setq Column# (1+ Column#)) );repeat (setq *ExcelData@ (append *ExcelData@ (list Data@))) (setq Row# (1+ Row#)) );repeat (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False) (vlax-invoke-method *ExcelApp% 'Quit) (vlax-release-object *ExcelApp%)(gc) (setq *ExcelApp% nil) *ExcelData@ );defun GetExcel ;------------------------------------------------------------------------------- ; GetCell - Returns the cell value from the *ExcelData@ list ; Arguments: 1 ; Cell$ = Cell ID ; Syntax example: (GetCell "E19") = value of cell E19 ;------------------------------------------------------------------------------- (defun GetCell (Cell$ / Column# ColumnRow@ Return Row#) (setq ColumnRow@ (ColumnRow Cell$)) (setq Column# (1- (nth 0 ColumnRow@))) (setq Row# (1- (nth 1 ColumnRow@))) (setq Return "") (if *ExcelData@ (if (and (>= (length *ExcelData@) Row#)(>= (length (nth 0 *ExcelData@)) Column#)) (setq Return (nth Column# (nth Row# *ExcelData@))) );if );if Return );defun GetCell ;------------------------------------------------------------------------------- ; OpenExcel - Opens an Excel spreadsheet ; Arguments: 3 ; ExcelFile$ = Excel filename or nil for new spreadsheet ; SheetName$ = Sheet name or nil for not specified ; Visible = t for visible or nil for hidden ; Syntax examples: ; (OpenExcel "C:\\Temp\\Temp.xls" "Sheet2" t) = Opens C:\Temp\Temp.xls on Sheet2 as visible session ; (OpenExcel "C:\\Temp\\Temp.xls" nil nil) = Opens C:\Temp\Temp.xls on current sheet as hidden session ; (OpenExcel nil "Parts List" nil) = Opens a new spreadsheet and creates a Part List sheet as hidden session ;------------------------------------------------------------------------------- (defun OpenExcel (ExcelFile$ SheetName$ Visible / Sheet$ Sheets@ Worksheet) (if (= (type ExcelFile$) 'STR) (if (findfile ExcelFile$) (setq *ExcelFile$ ExcelFile$) (progn (alert (strcat "Excel file " ExcelFile$ " not found.")) (exit) );progn );if (setq *ExcelFile$ "") );if (gc) (if (setq *ExcelApp% (vlax-get-object "Excel.Application")) (progn (alert "Close all Excel spreadsheets to continue!") (vlax-release-object *ExcelApp%)(gc) );progn );if (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application")) (if ExcelFile$ (if (findfile ExcelFile$) (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$) (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add) );if (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add) );if (if Visible (vla-put-visible *ExcelApp% :vlax-true) );if (if (= (type SheetName$) 'STR) (progn (vlax-for Sheet$ (vlax-get-property *ExcelApp% "Sheets") (setq Sheets@ (append Sheets@ (list (vlax-get-property Sheet$ "Name")))) );vlax-for (if (member SheetName$ Sheets@) (vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets") (if (= (vlax-get-property Worksheet "Name") SheetName$) (vlax-invoke-method Worksheet "Activate") );if );vlax-for (vlax-put-property (vlax-invoke-method (vlax-get-property *ExcelApp% "Sheets") "Add") "Name" SheetName$) );if );progn );if (princ) );defun OpenExcel ;------------------------------------------------------------------------------- ; PutCell - Put values into Excel cells ; Arguments: 2 ; StartCell$ = Starting Cell ID ; Data@ = Value or list of values ; Syntax examples: ; (PutCell "A1" "PART NUMBER") = Puts PART NUMBER in cell A1 ; (PutCell "B3" '("Dim" 7.5 "9.75")) = Starting with cell B3 put Dim, 7.5, and 9.75 across ;------------------------------------------------------------------------------- (defun PutCell (StartCell$ Data@ / Cell$ Column# ExcelRange Row#) (if (= (type Data@) 'STR) (setq Data@ (list Data@)) ) (setq ExcelRange (vlax-get-property *ExcelApp% "Cells")) (if (Cell-p StartCell$) (setq Column# (car (ColumnRow StartCell$)) Row# (cadr (ColumnRow StartCell$)) );setq (if (vl-catch-all-error-p (setq Cell$ (vl-catch-all-apply 'vlax-get-property (list (vlax-get-property *ExcelApp% "ActiveSheet") "Range" StartCell$)) );setq );vl-catch-all-error-p (alert (strcat "The cell ID \"" StartCell$ "\" is invalid.")) (setq Column# (vlax-get-property Cell$ "Column") Row# (vlax-get-property Cell$ "Row") );setq );if );if (if (and Column# Row#) (foreach Item Data@ (vlax-put-property ExcelRange "Item" Row# Column# (vl-princ-to-string Item)) (setq Column# (1+ Column#)) );foreach );if (princ) );defun PutCell ;------------------------------------------------------------------------------- ; CloseExcel - Closes Excel spreadsheet ; Arguments: 1 ; ExcelFile$ = Excel saveas filename or nil to close without saving ; Syntax examples: ; (CloseExcel "C:\\Temp\\Temp.xls") = Saveas C:\Temp\Temp.xls and close ; (CloseExcel nil) = Close without saving ;------------------------------------------------------------------------------- (defun CloseExcel (ExcelFile$ / Saveas) (if ExcelFile$ (if (= (strcase ExcelFile$) (strcase *ExcelFile$)) (if (findfile ExcelFile$) (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "Save") (setq Saveas t) );if (if (findfile ExcelFile$) (progn (vl-file-delete (findfile ExcelFile$)) (setq Saveas t) );progn (setq Saveas t) );if );if );if (if Saveas (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "SaveAs" ExcelFile$ -4143 "" "" :vlax-false :vlax-false nil );vlax-invoke-method );if (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False) (vlax-invoke-method *ExcelApp% 'Quit) (vlax-release-object *ExcelApp%)(gc) (setq *ExcelApp% nil *ExcelFile$ nil) (princ) );defun CloseExcel ;------------------------------------------------------------------------------- ; ColumnRow - Returns a list of the Column and Row number ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Cell$ = Cell ID ; Syntax example: (ColumnRow "ABC987") = '(731 987) ;------------------------------------------------------------------------------- (defun ColumnRow (Cell$ / Column$ Char$ Row#) (setq Column$ "") (while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91) (setq Column$ (strcat Column$ Char$) Cell$ (substr Cell$ 2) );setq );while (if (and (/= Column$ "") (numberp (setq Row# (read Cell$)))) (list (Alpha2Number Column$) Row#) '(1 1);default to "A1" if there's a problem );if );defun ColumnRow ;------------------------------------------------------------------------------- ; 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)) );+ );if );defun Alpha2Number ;------------------------------------------------------------------------------- ; 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#))) );if );if );defun Number2Alpha ;------------------------------------------------------------------------------- ; Cell-p - Evaluates if the argument Cell$ is a valid cell ID ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Cell$ = String of the cell ID to evaluate ; Syntax examples: (Cell-p "B12") = t, (Cell-p "BT") = nil ;------------------------------------------------------------------------------- (defun Cell-p (Cell$) (and (= (type Cell$) 'STR) (or (= (strcase Cell$) "A1") (not (equal (ColumnRow Cell$) '(1 1))) );or );and );defun Cell-p ;------------------------------------------------------------------------------- ; Row+n - Returns the cell ID located a number of rows from cell ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 2 ; Cell$ = Starting cell ID ; Num# = Number of rows from cell ; Syntax examples: (Row+n "B12" 3) = "B15", (Row+n "B12" -3) = "B9" ;------------------------------------------------------------------------------- (defun Row+n (Cell$ Num#) (setq Cell$ (ColumnRow Cell$)) (strcat (Number2Alpha (car Cell$)) (itoa (max 1 (+ (cadr Cell$) Num#)))) );defun Row+n ;------------------------------------------------------------------------------- ; Column+n - Returns the cell ID located a number of columns from cell ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 2 ; Cell$ = Starting cell ID ; Num# = Number of columns from cell ; Syntax examples: (Column+n "B12" 3) = "E12", (Column+n "B12" -1) = "A12" ;------------------------------------------------------------------------------- (defun Column+n (Cell$ Num#) (setq Cell$ (ColumnRow Cell$)) (strcat (Number2Alpha (max 1 (+ (car Cell$) Num#))) (itoa (cadr Cell$))) );defun Column+n ;------------------------------------------------------------------------------- ; rtosr - Used to change a real number into a short real number string ; stripping off all trailing 0's. ; Arguments: 1 ; RealNum~ = Real number to convert to a short string real number ; Returns: ShortReal$ the short string real number value of the real number. ;------------------------------------------------------------------------------- (defun rtosr (RealNum~ / DimZin# ShortReal$) (setq DimZin# (getvar "DIMZIN")) (setvar "DIMZIN" (setq ShortReal$ (rtos RealNum~ 2 ) (setvar "DIMZIN" DimZin#) ShortReal$ );defun rtosr ;------------------------------------------------------------------------------- (princ);End of GetExcel.lsp ;;;THIS IS THE ORIGINAL CODE PULLED FROM [url]http://www.cadtutor.net/forum/archive/index.php/t-89036.html?[/url] ;;;top half not used....just the setdynpropvalue (defun c:test ( / blk ) (if (and (setq blk (car (entsel "\nSelect dynamic block: "))) (setq blk (vlax-ename->vla-object blk)) (= "AcDbBlockReference" (vla-get-objectname blk)) (= :vlax-true (vla-get-isdynamicblock blk)) ) (LM:setdynpropvalue blk "distance1" 1.0) ) (princ) ) ;; Set Dynamic Block Property Value - Lee Mac ;; Modifies the value of a Dynamic Block property (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; prp - [str] Dynamic Block property name (case-insensitive) ;; val - [any] New value for property ;; Returns: [any] New value if successful, else nil (defun LM:setdynpropvalue ( blk prp val ) (setq prp (strcase prp)) (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (progn (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x)))) (cond (val) (t)) ) ) ) (vlax-invoke blk 'getdynamicblockproperties) ) ) (vl-load-com) (princ) ;;;;;;;;;;;; ;;;Test for plugging excel numbers into dynamic blocks (defun c:dynant () (GetExcel "C:\\Users\\eli.garcia\\Desktop\\getexceltest.xls" "Sheet1" "B5");<-- Edit Filename.xls (setq DA (GetCell "B2"));Or you can just use the global *ExcelData@ list ( / blk ) (if (and (setq blk (car (entsel "\nSelect dynamic block: "))) (setq blk (vlax-ename->vla-object blk)) (= "AcDbBlockReference" (vla-get-objectname blk)) (= :vlax-true (vla-get-isdynamicblock blk)) ) ((LM:setdynpropvalue blk "depth" DA) (LM:setdynpropvalue blk "half-width" DA)) ) (princ) ) ) I've attempted to attached a text file of all of this, but apparently that tool is broken right now, thus the huge post. I'm pretty close to being a novice at this, but I'm learning in the little time my work allows. My thought is that the way I used SETQ is wrong or that SETQ can't work with Excel like this. Please help.
  24. Okay guys so here is what I am looking for, I want to write a lisp or modify an existing lisp, that will select blocks within a given selection frame and summarize the attribute data in table either in the drawing or an excel file. I found LeeMac's awesome program "Count Attribute Values" but my issues is that for right now its still way over my head so I am having difficulties following much of it. Also I would like to limit it to blocks with a certain name(s) and then within that block only summarize one specific attribute because the blocks have a count attributes which isn't necessary. If anyone can give me some guidance or something I can build off of it would be greatly appreciated. Also I know EATTEXT can do this but I am looking for something substantially quicker.
  25. Hi, Would it be possible to create a LISP routine that can take 300-1000 AutoCAD files and rename dimstyle,textstyle automatically? : Cry:: Cry:
×
×
  • Create New...