Jump to content

Search the Community

Showing results for tags 'lisp'.

  • Search By Tags

    Type tags separated by commas.
  • Search By Author

Content Type


  • 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


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

Find results in...

Find results that contain...

Date Created

  • Start


Last Updated

  • Start


Filter by number of...

  1. RubberDinero

    Change entity layer

    At my job, i have a very tedious job of changing layers from proposed to existing and vice versa our layer setup is very basic "LayerName"=existing layer "LayerName-PR"=Proposed layer. i have recently bought a book to to learn AutoLisp and I've gotten the basic concept. I know that i want to ssget LayerName and setq that name to L then CHPROP LA to L-PR. but i want to know if someone has anything like this already and could help me. I'd like to do a mass select and have it automatically change the entities to their respective PR layer. also vice versa, to remove PR. i'm not looking for a layer renaming lisp. i'm looking for a entity layer changing lisp. anything helps. thanks.
  2. KrazyMann225

    Close without saving

    I wanted a command to close and not to save. I used the following code: (defun c:cln () ;Close No save (setvar "cmdecho" 0) (command "close" "No") (setvar "cmdecho" 1) ) But when I use it, it closes and saves.....help :S
  3. I want to add another layer to my routine to allow saving of layer state for On/off, Lock, Freeze, and restore them back after routine. I got the locked layer part but i could not understand this awesome crazy simple routine by Kent1Copper from Autodesk Forum (defun GLL (/ lay); = Get Locked Layers (while (setq lay (tblnext "layer" (not lay))) (if (= (logand (cdr (assoc 70 lay)) 4) 4); locked (setq LockedLayers (strcat (cond (LockedLayers) ("")) (cdr (assoc 2 lay)) ",")) ); if ); while ); defun (defun UAL (); = Unlock All Layers (command "_.layer" "_unlock" "*" "") ); defun (defun RLL () ; = Relock [formerly] Locked Layers (command "_.layer" "_lock" LockedLayers "") ); defun Basically, I do not understand this part of code below, where and how it capture the lock/unlock layer state and how i can capture the on/off & freeze layer state (while (setq lay (tblnext "layer" (not lay))) (if (= (logand (cdr (assoc 70 lay)) 4) 4); locked (setq LockedLayers (strcat (cond (LockedLayers) ("")) (cdr (assoc 2 lay)) ",")) ); if ); while Many thanks in advance.
  4. Hi there, I'm AM and new to the forum I'm creating a set of easy lisp routines for my team. I've loaded the following lisp file into AutoCAD and it works fine when typing the function ColorOffsetV031 into the command line within AutoCAD. However, when I try create a new command that will run the lisp with a macro like ^C^CColorOffsetV031 or ^C^C_ColorOffsetV031 so I can then add it to a ribbon/tab/tool palette, I get the following error: "_ColorOffsetV031 Unknown command "COLOROFFSETV031". Press F1 for help." I'm honestly not sure what I'm doing wrong. I've tried different ways of loading the lisp file, from just dropping the file into AutoCAD, adding it to the Startup Suite, loading it as an application etc. I've created 'buttons' like this before, and I feel so silly asking such a simple question; It's probably something really simple that I just can't pick up on... Even if someone can point me in the direction of a related post from someone else I would be very grateful The lisp: ; Define the tool/function name and variables (defun C:ColorOffsetV31 ( / EName EInfo EColor Group ans ansColor) (setvar "CMDECHO" 1) ; Set the options for user choice (initget "Orange Red Yellow Green Cyan Blue Magenta White L-Grey") ; Ask for user input on color for offset (setq ans (cond ((getkword "\nChoose offset object color [Orange/Red/Yellow/Green/Cyan/Blue/Magenta/White/L-Grey] or ENTER for Orange")) ("Orange"))) ; Set ansColor as input color (cond ((= ans "Orange") (setq ansColor 30)) ((= ans "Red") (setq ansColor 1)) ((= ans "Yellow") (setq ansColor 2)) ((= ans "Green") (setq ansColor 3)) ((= ans "Cyan") (setq ansColor 4)) ((= ans "Blue") (setq ansColor 5)) ((= ans "Magenta") (setq ansColor 6)) ((= ans "White") (setq ansColor 7)) ((= ans "L-Grey") (setq ansColor 8)) ; Should not happen but just here incase no input is given, set ansColor to BLACK (t (setq ansColor 250)) ) ;----------------------------- ; Start OFFSET (command "OFFSET" pause) ; Do the following with OFFSET (while (= 1 (logand 1 (getvar "CMDACTIVE"))) (command pause) ; While OFFSET command is on (while (= 1 (logand 1 (getvar "CMDACTIVE"))) (command pause) ; Set the current entity to be used as the last clicked entity (setq EName (entlast)) ; Get entity info (setq EInfo (entget EName)) ; If the colour of the object isn't known (if (not EColor) ; Match ans to EColor (setq EColor ansColor) ) ; Change the colour (entmod (append EInfo (list (cons 62 EColor)))) ) ) (setvar "CMDECHO" 0) (princ) ) Here's a copy of the command itself too Thanks, AM
  5. Hello to everyone. I have a file that can draw the longitudinal path of a water line, but it lacks some technical details, such as drawing the boundaries of the table beneath the chart and signing the depth calculated by the lisp as it is, rather than minus a distance estimated by the pipe's radius. Please seek assistance from people with relevant experience. Attachment: Assign Excel and Lisp next to a CAD file that almost has a work model with some notes. WATER PROFILE SPREADSHEET.xlsx TEST PROFILE NOT COMPLETING DRAWING BY LISP AND XLS.dwg WaterProfile.LSP
  6. I'm trying to figure out how to write a LISP command where I can click on multiple pipe network pipes from an XREF, and it copies them into my current drawing on the current layer, changing the linetype to contiguous, color to ByLayer, and seta global width of 1. Current theory on how this 'might' be accomplished: -click on xref pipe network pipe -it ncopy's item with base point 0,0 -explode items -burst items -set global width of all items to 1 -change linetype to contiguous for all items -change layer to current layer for all items -join all items that are touching (create one polyline from a group of pipe network pipe items) Thoughts? Thanks. --Matt
  7. hello i want help for creating lisp for me please ... the lisp will do these functions 1- as the attached image (1a) if i have block with yellow at right and some green blocks 2- i want when i launch the lisp to ask me to draw poly line that i want as in image 2a 3- after that when i draw this path with polyline and press enter the lisp ask me to choose blocks that i want to connect to this polyline and i will choose one by one or multiple blocks then after choosing the blocks and press enter ... the lisp will offset the main polyline that i draw and connect every polyline with the basepoint of the blocks that i choose sequentially as appear in this image 5a (attached DWG) can anyone help me please sample.dwg
  8. Greetings my friends I need some help with this lisp, this lisp (Medz v3.lsp) it basically makes a measurement of all lines arc and put the results in an new excel file divided by layer, linetype, color and length, this lisp works well but i need help to make the follow a modification: I need that the results to be in a specifc excel file (see attach xlsx file) on the "MED AUX" tab with the range A11:D11, it seems a simple modification, but i don't have the knowledge to do it. Many thanks MedZ v3.lsp Mede Aux.xlsx
  9. Hi! I have this code that i found here in the forum it was created by @rlx. My question is how to add an automatic current date and time to the end of the file when im saving it. Many thanks! xoxo (defun c:foo (/ _dir F NF P SF SH) (defun _dir (msg path / sh folder out) (or (vl-file-directory-p path) (setq path (getvar 'dwgprefix))) (cond ((and (setq sh (vlax-get-or-create-object "Shell.Application")) (setq folder (vlax-invoke-method sh 'browseforfolder 0 msg "&H2000" path)) ) (setq out (vlax-get-property (vlax-get-property folder 'self) 'path)) (setq out (strcat (vl-string-right-trim "\\" out) "\\")) ) ) (and sh (vlax-release-object sh)) out ) (if (setq p (_dir "Pick a directory yo!" "E:\\Autocad Files\\SSC\\North Region\\SNE\\")) (progn (setq f (getvar 'dwgname)) (setq sf "Plans") (setq nf (strcat p sf "\\" f)) (cond ((cond ((findfile nf) (print "File exists...") nil) ((vl-file-directory-p (strcat p sf)) (vl-file-copy (strcat (getvar 'dwgprefix) f) nf) t) ((vl-mkdir (strcat p sf)) (vl-file-copy (strcat (getvar 'dwgprefix) f) nf) t) ) (setq sh (vlax-get-or-create-object "Shell.Application")) (vlax-invoke-method sh 'open nf) (vlax-release-object sh) ) ) ) ) (princ) ) (vl-load-com)
  10. i need lisp program like fillet or join as mention attached pic.
  11. Hi, I havent done much of AutoCAD LISP writing, and certainly not for many years now, but I was trying to figure out how to make a simple function that would draw a cross with 2 diagonal lines, from lower left corner PT1 to upper right corner PT2. I thought it might be possible to draw a -pline from PT1(X1,Y1) - PT2(X2,Y2) -second pline from (X1,Y2) - (X2,Y1) This would save me time drawing different size crosses by letting me draw 2 diagonal line by clicking just two points could anyone help me with a code for this?
  12. Hello, I was getting a drawing that I have to modify. The problem is, that in this drawing are several block references with the name. I.e. I have about 100 block references calling "WcLux" . Is there a possibility to make the name of the block reference unique with a script: WcLux_1, WcLux2, ... WcLux100 Thx Frank
  13. (Hopefully this Question has not been asked. The Search gave no Results.) For Context: I have created a Program that generates a complex Component (Block, Wiring, Text) onto a Sheet. The Program uses .LSP and .DCL for ease of Use for our Operators. The Prompt has Options to configure the Component to any Options we need. Inquiry: I need to update the Program to include Wire Numbers and Wire Number Copies. (I will be trying to use "WD_PUTWNXY" Command for New Wire Networks, although I have yet to do so.) For Wire Number Copies, I was hoping to use either the "AECOPYWIRENO" or "WD_COPY_WN" Commands. The Problem with these Commands is that they do not allow for Coordinate Placement. When running either Command, the Command Line is requesting to select a Wire as an Entity. What I would like, is an example of a LISP that completes this Task using a Coordinate System to select and place the Wire Number Copies. Any Advice would be much appreciated!
  14. Hello, I am new to LISP, I found the Area-to-Table LISP from Lee Mac, which is very useful, but I need it to write the area in the third column of the table instead of the second. I modified some parameters to create the third column and the first row of the table works, but the following rows don't. Also I would like to have the numbers that are inserted in the centroid in a circle, but this could be optional. The text should be 0.3 in height and the circle should have a 0.25 radius. I defined the style at the beginning, but the height does not work. I would be grateful for some help, thank you! This is the LISP: (defun c:Recap nil (AreaLabel t)) ;; Areas to Table ;start of sectin added to define text style (entmakex '( (0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "room_Style") (70 . 0) (40 . 0.3);<- text height defined (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 2.0) (3 . "times.ttf") (4 . "") ) ) (setvar 'textstyle "room_Style") ; end of section added to define text style ;;------------------------------------------------------------;; (defun AreaLabel ( flag / *error* _startundo _endundo _centroid _text _open _select _getobjectid _isannotative acdoc acspc ap ar as cf cm el fd fl fo n of om p1 pf pt sf st t1 t2 t3 tb th ts tx ucsxang ucszdir ) ;;------------------------------------------------------------;; ;; Adjustments ;; ;;------------------------------------------------------------;; (setq h1 "Recap Table" ;; Heading t1 "Numer" ;; Number Title t2 "Room" ;;Area Name t3 "Area" ;; Area Title pf "" ;; Number Prefix (optional, "" if none) sf "" ;; Number Suffix (optional, "" if none) ap "" ;; Area Prefix (optional, "" if none) as "" ;; Area Suffix (optional, "" if none) cf 1.0 ;; Area Conversion Factor (e.g. 1e-6 = mm2->m2) fd t ;; Use fields to link numbers/objects to table (t=yes, nil=no) fo "%lu6%qf1" ;; Area field formatting ) ;;------------------------------------------------------------;; (defun *error* ( msg ) (if cm (setvar 'CMDECHO cm)) (if el (progn (entdel el) (setq el nil))) (if acdoc (_EndUndo acdoc)) (if (and of (eq 'FILE (type of))) (close of)) (if (and Shell (not (vlax-object-released-p Shell))) (vlax-release-object Shell)) (if (null (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) ) ) ;;------------------------------------------------------------;; (defun _centroid ( space objs / reg cen ) (setq reg (car (vlax-invoke space 'addregion objs)) cen (vlax-get reg 'centroid) ) (vla-delete reg) (trans cen 1 0) ) ;;------------------------------------------------------------;; (defun _text ( space point string height rotation / text ) (setq text (vla-addtext space string (vlax-3D-point point) height)) (vla-put-alignment text acalignmentmiddlecenter) (vla-put-textalignmentpoint text (vlax-3D-point point)) (vla-put-rotation text rotation) text ) ;;------------------------------------------------------------;; (defun _Open ( target / Shell result ) (if (setq Shell (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application")) (progn (setq result (and (or (eq 'INT (type target)) (setq target (findfile target))) (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke (list Shell 'Open target)) ) ) ) ) (vlax-release-object Shell) ) ) result ) ;;------------------------------------------------------------;; (defun _Select ( msg pred func init / e ) (setq pred (eval pred)) (while (progn (setvar 'ERRNO 0) (apply 'initget init) (setq e (func msg)) (cond ( (= 7 (getvar 'ERRNO)) (princ "\nMissed, try again.") ) ( (eq 'STR (type e)) nil ) ( (vl-consp e) (if (and pred (not (pred (setq e (car e))))) (princ "\nInvalid Object Selected.") ) ) ) ) ) e ) ;;------------------------------------------------------------;; (defun _GetObjectID ( doc obj ) (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE")) (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false) (itoa (vla-get-Objectid obj)) ) ) ;;------------------------------------------------------------;; (defun _isAnnotative ( style / object annotx ) (and (setq object (tblobjname "STYLE" style)) (setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative"))))) (= 1 (cdr (assoc 1070 (reverse annotx)))) ) ) ;;------------------------------------------------------------;; (setq acdoc (vla-get-activedocument (vlax-get-acad-object)) acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)) ucszdir (trans '(0. 0. 1.) 1 0 t) ucsxang (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 ucszdir)) ) (_StartUndo acdoc) (setq cm (getvar 'CMDECHO)) (setvar 'CMDECHO 0) (setq om (eq "1" (cond ((getenv "LMAC_AreaLabel")) ((setenv "LMAC_AreaLabel" "0"))))) (setq ts (/ (getvar 'TEXTSIZE) (if (_isAnnotative (getvar 'TEXTSTYLE)) (cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 )) 1.0 ) ) ) (cond ( (not (vlax-method-applicable-p acspc 'addtable)) (princ "\n--> Table Objects not Available in this Version.") ) ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER)))))) (princ "\n--> Current Layer Locked.") ) ( (not (setq *al:num (cond ( (getint (strcat "\nSpecify Starting Number <" (itoa (setq *al:num (1+ (cond ( *al:num ) ( 0 ))))) ">: " ) ) ) ( *al:num ) ) ) ) ) ( flag (setq th (* 2. (if (zerop (setq th (vla-gettextheight (setq st (vla-item (vla-item (vla-get-dictionaries acdoc) "ACAD_TABLESTYLE" ) (getvar 'CTABLESTYLE) ) ) acdatarow ) ) ) ts (/ th (if (_isAnnotative (vla-gettextstyle st acdatarow)) (cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 )) 1.0 ) ) ) ) ) (if (cond ( (progn (initget "Add") (vl-consp (setq pt (getpoint "\nPick Point for Table <Add to Existing>: "))) ) (setq tb (vla-addtable acspc (vlax-3D-point (trans pt 1 0)) 2 3 th (* 1.2 th (max (strlen t1) (strlen t2) (strlen t3))) ;chage tabel row, column, column height ) ) (vla-put-direction tb (vlax-3D-point (getvar 'UCSXDIR))) (vla-settext tb 0 0 h1) (vla-settext tb 1 0 t1) (vla-settext tb 1 1 t2) (vla-settext tb 1 2 t3) (while (progn (if om (setq p1 (_Select (strcat "\nSelect Object [Pick] <Exit>: ") '(lambda ( x ) (and (vlax-property-available-p (vlax-ename->vla-object x) 'area) (not (eq "HATCH" (cdr (assoc 0 (entget x))))) (or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x)) ) ) entsel '("Pick") ) ) (progn (initget "Object") (setq p1 (getpoint "\nPick Area [Object] <Exit>: "))) ) (cond ( (null p1) (vla-delete tb) ) ( (eq "Pick" p1) (setq om nil) t ) ( (eq "Object" p1) (setq om t) ) ( (eq 'ENAME (type p1)) (setq tx (cons (_text acspc (_centroid acspc (list (setq p1 (vlax-ename->vla-object p1)))) (strcat pf (itoa *al:num) sf) ts ucsxang ) tx ) ) (vla-insertrows tb (setq n 2) th 1) (vla-settext tb n 2 ;changed here from 1 to 2 (if fd (strcat "%<\\AcObjProp Object(%<\\_ObjId " (_GetObjectID acdoc p1) ">%).Area \\f \"" fo "\">%" ) (strcat ap (rtos (* cf (vla-get-area p1)) 2) as) ) ) (vla-settext tb n 0 (if fd (strcat "%<\\AcObjProp Object(%<\\_ObjId " (_GetObjectID acdoc (car tx)) ">%).TextString>%" ) (strcat pf (itoa *al:num) sf) ) ) nil ) ( (vl-consp p1) (setq el (entlast)) (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "") (if (not (equal el (setq el (entlast)))) (progn (setq tx (cons (_text acspc (_centroid acspc (list (vlax-ename->vla-object el))) (strcat pf (itoa *al:num) sf) ts ucsxang ) tx ) ) (vla-insertrows tb (setq n 2) th 1) (vla-settext tb n 1 (strcat ap (rtos (* cf (vlax-curve-getarea el)) 2) as)) (vla-settext tb n 0 (if fd (strcat "%<\\AcObjProp Object(%<\\_ObjId " (_GetObjectID acdoc (car tx)) ">%).TextString>%" ) (strcat pf (itoa *al:num) sf) ) ) (redraw el 3) nil ) (vla-delete tb) ) ) ) ) ) (not (vlax-erased-p tb)) ) ( (and (setq tb (_Select "\nSelect Table to Add to: " '(lambda ( x ) (eq "ACAD_TABLE" (cdr (assoc 0 (entget x))))) entsel nil ) ) (< 1 (vla-get-columns (setq tb (vlax-ename->vla-object tb)))) ) (setq n (1- (vla-get-rows tb)) *al:num (1- *al:num)) ) ) (progn (while (if om (setq p1 (_Select (strcat "\nSelect Object [" (if tx "Undo/" "") "Pick] <Exit>: ") '(lambda ( x ) (and (vlax-property-available-p (vlax-ename->vla-object x) 'area) (not (eq "HATCH" (cdr (assoc 0 (entget x))))) (or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x)) ) ) entsel (list (if tx "Undo Pick" "Pick")) ) ) (progn (initget (if tx "Undo Object" "Object")) (setq p1 (getpoint (strcat "\nPick Area [" (if tx "Undo/" "") "Object] <Exit>: "))) ) ) (cond ( (and tx (eq "Undo" p1)) (if el (progn (entdel el) (setq el nil))) (vla-deleterows tb n 1) (vla-delete (car tx)) (setq n (1- n) tx (cdr tx) *al:num (1- *al:num)) ) ( (eq "Undo" p1) (princ "\n--> Nothing to Undo.") ) ( (eq "Object" p1) (if el (progn (entdel el) (setq el nil))) (setq om t) ) ( (eq "Pick" p1) (setq om nil) ) ( (and om (eq 'ENAME (type p1))) (setq tx (cons (_text acspc (_centroid acspc (list (setq p1 (vlax-ename->vla-object p1)))) (strcat pf (itoa (setq *al:num (1+ *al:num))) sf) ts ucsxang ) tx ) ) (vla-insertrows tb (setq n (1+ n)) th 1) (vla-settext tb n 1 (if fd (strcat "%<\\AcObjProp Object(%<\\_ObjId " (_GetObjectID acdoc p1) ">%).Area \\f \"" fo "\">%" ) (strcat ap (rtos (* cf (vla-get-area p1)) 2) as) ) ) (vla-settext tb n 0 (if fd (strcat "%<\\AcObjProp Object(%<\\_ObjId " (_GetObjectID acdoc (car tx)) ">%).TextString>%" ) (strcat pf (itoa *al:num) sf) ) ) ) ( (vl-consp p1) (if el (progn (entdel el) (setq el nil))) (setq el (entlast)) (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "") (if (not (equal el (setq el (entlast)))) (progn (setq tx (cons (_text acspc (_centroid acspc (list (vlax-ename->vla-object el))) (strcat pf (itoa (setq *al:num (1+ *al:num))) sf) ts ucsxang ) tx ) ) (vla-insertrows tb (setq n (1+ n)) th 1) (vla-settext tb n 1 (strcat ap (rtos (* cf (vlax-curve-getarea el)) 2) as)) (vla-settext tb n 0 (if fd (strcat "%<\\AcObjProp Object(%<\\_ObjId " (_GetObjectID acdoc (car tx)) ">%).TextString>%" ) (strcat pf (itoa *al:num) sf) ) ) (redraw el 3) ) (princ "\n--> Error Retrieving Area.") ) ) ) ) (if el (progn (entdel el) (setq el nil))) ) ) ) ) (setenv "LMAC_AreaLabel" (if om "1" "0")) (setvar 'CMDECHO cm) (_EndUndo acdoc) (princ) ) ;;------------------------------------------------------------;; ;; End of File ;; ;;------------------------------------------------------------;;
  15. hi can anyone here help write a lisp routine that can be run project wide to hide/show attributes . The user must be given an option to select an object , write or select attribute name and also select multiple drawings from the project. I have a code that updates the attribute value , attaching that - Please help change that to hide/show attributes updateATTRIB.lsp
  16. Hi, I am Michel Can you kindly to help me to. I need a lisp for a cable routing. I have just a block consist of 3 attributes (TAG, SRTP, MVZ). I need to extract each relating value in separate column in excel. For example, if I select 5 blocks in drawing, I need to have 5 columns, each column has only 3 rows (3 attributes) and the possibility to have different rows for different electric cables in same file. Thank you in advance Michel richiesta.xlsx
  17. abcdef1234


    ;VPFL - VP Freeze Layer ;(discussion forum routine, modified by XANADU) ; (defun c:VZ ( / ent cLayer pLayer) (setq ent (car(entsel "\nSelect object to VP-freeze layer: "))) (setq cLayer (getvar "clayer")) (setq pLayer (cdr (assoc 8 (entget ent)))) (if (= pLayer cLayer) (command "_.layer" "_s" "0" "_off" pLayer "") (command "_.vplayer" "_f" pLayer "_c" "") ) (prompt (strcat "Layer " pLayer " frozen in current viewport")) (princ) ) using vp freeze lisp i want to unfreeze lisp in viewport
  18. hello everybody , hope u all are great ... i have this lisp to get sum of some texts in autocad by choosing them one by one , but instead i wanna select those texts in one time by one selection click for them all ... i really appreciate ur help thanks in advance ;; wrriten by dlanorh from cadtutor (defun rh:em_txt ( pt txt lyr sty tht xsf) (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf)) );end_list );end_entmakex );end_defun (vl-load-com) (defun c:t+ ( / *error* sv_lst sv_vals ent elst el num xsf ans tot qflg nlst sel pt txt) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred."))) (princ) );end_defun (setq sv_lst (list 'cmdecho 'osmode 'dynmode 'dynprompt) sv_vals (mapcar 'getvar sv_lst) );end_setq (mapcar 'setvar sv_lst '(0 0 3 1)) (while (not tot) (setq el (entget (setq ent (car (entsel "\Select First Text Number Entity : "))))) (cond ( (wcmatch (cdr (assoc 0 el)) "*TEXT") (cond ( (= (cdr (assoc 0 el)) "TEXT") (setq num (atof (getpropertyvalue ent "TextString")) xsf (cdr (assoc 41 el)))) (t (setq num (atof (getpropertyvalue ent "Text")) xsf 1.0)) );end_cond (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number")) (t (setq tot num))) ) (t (alert "Not a Text Entity")) );end_cond (cond (num (setq nlst (cons ent nlst)))) );end_while (while (not qflg) (setq sel (entsel "\nSelect Next Text Number Entity : ")) (cond ( (not sel) (initget "Yes No") (setq ans (cond ( (getkword "\nSelection Finished [Yes/No] <No>")) ("No"))) (if (= ans "Yes") (setq qflg T)) ) );end_cond (cond ( (and (not qflg) sel) (setq elst (entget (setq ent (car sel)))) (cond ( (and (wcmatch (cdr (assoc 0 elst)) "*TEXT") (not (vl-position ent nlst))) (cond ( (= (cdr (assoc 0 elst)) "TEXT") (setq num (atof (getpropertyvalue ent "TextString")))) (t (setq num (atof (getpropertyvalue ent "Text")))) );end_cond (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number"))) ) ( (vl-position ent nlst) (alert "Already Selected") (setq num nil)) (t (alert "Not a Text Entity")) );end_cond (if num (setq tot (+ tot num) nlst (cons ent nlst) num nil)) ) );end_cond );end_while (cond ( (and tot qflg) (setq pt (getpoint "\nSelect Total Insertion Point : ") txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)) );end_setq (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) xsf) (if nlst (foreach o (mapcar 'vlax-ename->vla-object nlst) (vla-delete o))) ) );end_cond (mapcar 'setvar sv_lst sv_vals) (princ) );end_defun
  19. Hey guys, this is my first post on this forum so thanks in advance for any help. Currently I am using Lee Macs "Field to attribute" lisp command to get the length of a line (a steel beam in this case) and insert the field into a block to get an item count. Currently I've modified the LISP command to format the length from feet-inches into a single number to represent a 1' spacing of our product. What I want to do is either take that field value (the length of the beam) and and 1'-0" to it, or take the formatted value and add 1 to it. The reason is when we draw our beams we like to shorten the lines by 6" on each side so we know what beams are separate members and which are continuous. This causes the field value to be 1'-0" less than it should be. Any help on this would be appreciated.
  20. 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") )
  21. Hello, I am searching for a lisp that can export the lengths of all selected polylines and export them to either Excel or an AutoCad table. I have found and tested around 20 lisps but so far cannot find the right one. There were only 2 that look promising, maybe they could be modified? One was by Lee Mac and the other Jimmy Bergmark. I can post the 2 Lisp if needed. The lisp would need to have you select multiple polylines and give the total lengths of each polyline in the order that they were selected in. Then the data would either appear on an AutoCad table or Excel. Thanks for any help that can be provided.
  22. Hello, I have some drawings containing 2D lines in multiple layers (by pipe diameter). Now I manually check each intersection or vertex and mark the right fittings needed. Is it possible to create a simple object (a circle or something) at each vertex/intersection in a layer named as for example "dia 315 Y" "dia 160 elbow".... it's only for informational purpose, the looks don't matter. I need to order the right pieces and that takes a hell of a lot of time.... example.dwg
  23. Hi Everyone, From few days I'm trying to make an auto lisp which can understand the difference between 2 different layers and calculate area according to that. Unfortunately I'm not getting proper results anyone can please help. I was trying to create the lisp in below steps. Step-1: After entering command user will select whole drawing in single selection Step-2: Lisp will select only object in Layer-1 & Layer-2 (Other layers objects will be ignored) Step-3: Lisp will calculated the area of Layer-1 & Layer-2 Step-4: Now it will Subtract the area of Layer-2 from Layer-1 Step-5: and paste it as Text.
  24. I would like to merge the lisps I show at the end into one, where the process is first ADDID.lsp and then OD2ATT.lsp If it were possible with your help to add a new functionality to addid.lsp and that is that when you copy the block name in the TIPO_SENAL field of the Object Data You can check the block name to be able to change it to another, with some examples it would be enough to add as many times as this operation is necessary. thank you very much, greetings .... (defun c:ADDID (/ n inc enam idd efn) (setq tn "SDM_SEN_SENALIZACION") (prompt "Seleccionar señales") (princ) (setq n (getint "\n Ingrese valor de Inicio: ") ss (ssget '((0 . "insert"))) ) (setq inc 0) (repeat (setq len (sslength ss)) (setq enam (ssname ss inc)) (setq idd (itoa n)) (setq efn(vla-get-effectivename(vlax-ename->vla-object enam))) (ade_odaddrecord enam tn) (ade_odsetfield enam tn "INTERNO_SENAL" 0 n) (ade_odsetfield enam tn "TIPO_SENAL" 0 efn) (command "chprop" enam "" "c" "ByLAyer" "") (setq inc (1+ inc) n (1+ n) ) ) (alert "The entities selected with INTERNO_SENAL were updated") (princ) ) .... (defun c:OD2ATT (/ ss) (vl-load-com) (if (setq ss (ssget '((0 . "INSERT") (2 . "`*U*")))) ((lambda (i / e s od r v n d tag) (while (setq e (ssname ss (setq i (1+ i)))) ;; Extract object data (setq b (ade_odgetfield e (setq od (car (ade_odgettables e))) "INTERNO_SENAL" 0)) ;; Populate attributes (if (and (setq n (vla-get-effectivename (setq v (vlax-ename->vla-object e)))) (setq d (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) n))) (foreach attrib (vlax-invoke v 'getattributes) (vlax-for item d (if (= (vla-get-objectname item) "AcDbAttributeDefinition") (if (= (vla-get-tagstring attrib) (vla-get-tagstring item)) (cond ((= "INTERNO" (setq tag (vla-get-tagstring item))) (vla-put-textstring attrib b)))))))) )) -1)) (princ)) ADDID.lsp OD2ATT.lsp eg.dwg
  25. Hi! With the help of the autodesk forum I have this lisp that consecutively increments a numeric value in a specific field of OD, also copies the block name to another field of the same OD. This lisp assigns the internal consecutively when the field INTERNO_SENAL has a data type of character, can the same process be done when the type of the OD field is as internal? Having this lisp is it possible that the value of INTERNO_SENAL is also copied in the INTERNO attribute of the block? ADD_ID.lsp
  • Create New...