Jump to content

Search the Community

Showing results for tags 'lisp'.



More search options

  • 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

Find results in...

Find results that contain...


Date Created

  • Start

    End


Last Updated

  • Start

    End


Filter by number of...

Found 458 results

  1. I'm wanting to create a way to quickly change the layers of a CADworx object. This is what I have so far but its not working like I want. The problem is no matter how many objects I select, it only changes the first then stops working completely. If I try to run it again and select another object it wont do anything. I need to be able to select objects manually. Can someone point me in the right direction? (defun C:ttt () (setq STL_SS nil) (graphscr) (setq STL_SS (ssget '((0 . "LINE")(8 . "CL_Steel"))));;;FIND ALL THE LINES ON LAYER CL-STEEL (setq CL_CNT 0) (if (/= STL_SS nil) (repeat (sslength STL_SS) (setq STL_NAME (ssname STL_SS CL_CNT)) (setvar "pickstyle" 0) (command "chprop" STL_NAME "" "LA" "BEAM_CL" "") (setq CL_CNT (1+ CL_CNT)) );;;repeat );;;if (setq STL_SS nil) (setq STL_SS (ssget "L" '((0 . "3DSOLID")(8 . "STEEL"))));;;FIND ALL THE SOLIDS ON LAYER STEEL (setq CL_CNT 0) (if (/= STL_SS nil) (repeat (sslength STL_SS) (setq STL_NAME (ssname STL_SS CL_CNT)) (command "chprop" STL_NAME "" "LA" "BEAM" "") (setq CL_CNT (1+ CL_CNT)) );;;repeat );;;if (setvar "pickstyle" 1) (princ) )
  2. Does anyone have any information on DraftSight and the use of lisps and setting variables, these are two separate questions. I currently can load a lisp and run them as I do in AutoCad but there are limitations/variations to certain things. Does anyone have a comparison or know the differences with the two programs? My next question is about setting variables in DraftSight, Command Line: (setq no1 10) returns 10, but when I invoke !no1 it returns Error: No Function. as if the value got wiped immediately after being set. Is there a System Variable I need to set to hold these variables or is it just not possible in DraftSight? Any information is much appreciated.
  3. aban

    Ortho with 45 degrees

    Hello, is there any way to get ortho to also include 45 degrees? I know polar tracking has the different angles, but I would need ortho to do that. If not, is there a way to make a lisp file to assign "DD" to turn that lisp file on? Please help with this because I really need this to work. Thank you!
  4. Hi. The following routine generates the exception e06d7363 when using (* push-error-using-command *). If I replace "myerror" (* push-error-using-command *) with (* push-error-using-stack *) and the "command" with "command-s", the exception is not generated; but when activating "myerror" the message is generated that indicates that I must use (* push-error-using-command *) or command-s. (defun test (a b / ) (entradaTest) ;;(*push-error-using-command*) (/ a b) (setq *DrawingGER* (vla-get-ActiveDocument (vlax-get-acad-object))) (setq LayersColeccion (vlax-get-property *DrawingGer* "Layers")) ;;Crea las layer necesarias para alojar las entidades del dibujo. (setq ListaLayers (list "Make_Tuberias" "Biseles" "3D_Perfil")) ;;Funcion: AX-EXISTE+. ;;Parametro "elemento" es una cadena con el nombre de elemento a buscar en una coleccion, ej (ax-existe+ "0" "LAYERS"). ;;Archivo iList.lsp (foreach X ListaLayers (if (not (ax-Existe+ X "Layers")) (vl-cmdf ".-layer" "New" X "T" X "")) ) (salidaTest) ;;(*pop-error-mode*) ) (defun myerror (s) (if (/= s "Function cancelled") (princ (strcat "\nError GER: " s)) ) (setvar "cecolor" color_org) (setvar "cvport" port_view_ger) (command "_vpoint" vpoint_ger) (command "_zoom" "W" MSMAX_GER MSMIN_GER) (setvar "clayer" clayer1) (setvar "INSUNITS" val_var_INSUNITS) (cmd-salir) (SETVAR "osmode" ref0) (setvar "3dosmode" 3DOSMODE_ORG) (setq *error* olderr) (command "_undo" "_end") (SETVAR "cmdecho" 1) (PRIN1) ) (defun entradaTest ( / ) (*push-error-using-command*) ;;(*push-error-using-stack*) (SETVAR "cmdecho" 0) (COMMAND "_undo" "_begin") (setq olderr *error* *error* myerror) (SETQ ref0 (GETVAR "osmode")) (SETVAR "osmode" 0) (setq 3DOSMODE_ORG (GETVAR "3dosmode")) (setvar "3dosmode" 0) (SETQ port_view_ger (getvar "cvport")) ;;(SETQ vpoint_ger (getvar "viewdir")) ;;(SETQ VSMAX_GER (getvar "vsmax")) ;;(SETQ VSMIN_GER (getvar "vsmin")) (setq val_var_INSUNITS (getvar "INSUNITS")) ;;(setvar "INSUNITS" 1) ;1 para pulgadas. (setq clayer1 (getvar "clayer")) (setvar "clayer" "0") (setq color_org (getvar "cecolor")) ) (defun salidaTest ( / ) (setvar "cecolor" color_org) ;;(setq *error* olderr) (setvar "cvport" port_view_ger) (command "_vpoint" vpoint_ger) (setvar "clayer" clayer1) (setvar "INSUNITS" val_var_INSUNITS) (SETVAR "osmode" ref0) (setvar "3dosmode" 3DOSMODE_ORG) (COMMAND "_undo" "_end") (setq *error* olderr) ; Restore old *error* handler (COMMAND "_undo" "_end") (SETVAR "cmdecho" 1) (*pop-error-mode*) (PRIN1) ) (defun AX-EXISTE+ (elemento coleccion / Colecciones temp X resultado *DrawingGER* Coleccion ) ;;Colecciones disponibles. (setq Colecciones (list "Blocks" "Dictionaries" "DimStyles" "FileDependencies" "Groups" "Layers" "Layouts" "LineTypes" "Materials" "ModelSpace" "PaperSpace" "PickFirstSelectionSet" "Plot" "PlotConfiguration" "Preferences" "RegisteredApplications" "SelectionSets" "SummaryInfo" "TextStyles" "UserCoordinatesSystems" "Utility" "Viewports" "Views") ) ;;Verifica si la coleccion existe en el documento actual. (setq temp nil) (foreach X Colecciones (if (equal (strcase coleccion) (strcase X)) (setq temp T)) ) (if temp (progn (setq *DrawingGER* (vla-get-ActiveDocument (vlax-get-acad-object))) ;;Obtiene el objeto DXF del dibujo actual. (setq Coleccion (vlax-get-property *DrawingGer* coleccion)) ;;Obtiene el objeto DXF de la Coleccion requerida, por ejemplo "Layers". (if (not (vl-catch-all-error-p (setq resultado (vl-catch-all-apply 'vla-item (list coleccion elemento))))) t nil) ) (progn (prompt (strcat "\n**(ax-Existe+) Nombre de coleccion \"" coleccion "\" no identificada.\n")) (princ) nil ) ) ) Any idea of the reason for the exception? Greetings.
  5. Dani_Nadir

    Automatic layout LISP

    Hello, I am interested in a LISP able to make overlapping sheets as layouts following a road alignment and overlap a fraction. Each sheet will have its own UCS or view orientation. You can see it from these videos: anyone knows one? Best regards, Daniel
  6. I am using AutoCAD VBA with array. I need to call a LISP function to pass a parameter (array). How can I the pass an array from VBA to LISP? I am using this expression: ThisDrawing.SendCommand "Myfunction"
  7. Hi. I have a lisp routine that I use all the time but I'm wondering if someone could please tell me how the routine sets the following variables: 1. The number of decimal places (precision) that the distance displays at. It currently displays it to 2 decimal places, I'd like to have 3 eg. 0.000 2. The text offset distance from the line. Thank you all in advance! (defun get_endpts (/ a b) (COMMAND "OSNAP" "ENDP") (setq a (getpoint "\nEnter first point: ")) (setq b (getpoint "\nEnter second point: ")) (COMMAND "OSNAP" "NONE") (list a b) ) (defun c:setdim () ;(initget (+ 1 2 4)) ;(setq scalefactor (getreal "\nEnter scale factor: ")) (if (not setmap) (load "setmap") ) (setmap) (setq scalefactor #mapsc) ;(initget 1 "Y y N n") ;(setq angflg (question "Do you want azimuths printed?")) (setq angflg "Y" angmessage "WILL") ;(cond (angflg ; (if (not (setq dimrotation (getangle "\nEnter angular rotation: "))) ; ;(setq dimrotation #mapang ) ; (setq DIMROTATION 0) ; ) ; (initget 1 "1 5") ; (setq secprec (atoi (getkword "\nRound off seconds to nearest <1 or 5> "))) ; ) ;) (setq dimrotation 0 secprec 5 secsmessage "5") (alert (strcat "DIMLINE SETTINGS: \n\nScale Factor set to: " (rtos scalefactor 2 6) "\nAzimuths " angmessage " print." "\nSeconds rounded off to " secsmessage "\"" "\n\n\nTo change the Scale Factor use MAP SETTINGS CSF \+ ROTATION \non the LISP pulldown.\n\nTo change other settings type SETDIM2.")) (setq dimset T) (princ) ;(chgsize (* (/ scalex 1000) 1.95)) );defun setdim (defun c:setdim2 () (initget (+ 1 2 4)) ;(setq scalefactor (getreal "\nEnter scale factor: ")) (if (not setmap) (load "setmap") ) (setq scalefactor #mapsc) (initget 1 "Y y N n") (setq angflg (question "Do you want azimuths printed?")) (if angflg (progn (setq DIMROTATION 0 angMessage "WILL") (initget 1 "1 5") (setq secsMessage (getkword "\nRound off seconds to nearest <1 or 5> ")) (setq secprec (atoi secsmessage)) ) (setq angMessage "WON'T" ) ) (alert (strcat "DIMLINE SETTINGS: \n\nScale Factor set to: " (rtos scalefactor 2 6) "\nAzimuths " angmessage " print." "\nSeconds rounded off to " secsmessage "\"" "\n\n\nTo change the Scale Factor use MAP SETTINGS CSF \+ ROTATION \non the LISP pulldown.")) (setq dimset T) ;(chgsize (* (/ scalex 1000) 1.95)) ) (defun c:dimline (/ L A B ucsflg) (load "F1") (cond ((not dimset) (c:setdim))) (if (/=(getvar "WORLDUCS") 1) (progn (command "UCS" "W") (setq UCSflg T) );progn );if (setq L (getline)) (dimfunc (getassoc 10 L) (getassoc 11 L) (placetxt (getassoc 10 L) (getassoc 11 L)) ) (if UCSflg (COMMAND "UCS" "P") ) ) (defun c:dimpts (/ ENDPTS ucsflg) (load "F1") (cond ((not dimset) (c:setdim))) (if (/=(getvar "WORLDUCS") 1) (progn (command "UCS" "W") (setq UCSflg T) );progn );if (dimfunc (car(setq ENDPTS(get_endpts))) (cadr ENDPTS) (placetxt (car ENDPTS)(cadr ENDPTS)) ) (if UCSflg (COMMAND "UCS" "P") ) ) (defun dimfunc (a b below / angab distab ctrpt d) (setq angab (angle a b)) (setq distab (distance a b)) (setq ctrpt (polar a angab (/ distab 2))) (setq d (/ distab scalefactor)) (cond (below (cond ((and (> angab (+ NORTH 0.1744)) (<= angab (+ SOUTH 0.1744))) (writedim d angab ctrpt (+ angab A90) (- angab PI) 1.20 2.85) ) (T (writedim d angab ctrpt (+ angab A270) angab 1.20 2.85)) ) ) (T (cond ((and (> angab (+ NORTH 0.1744)) (<= angab (+ SOUTH 0.1744))) (writedim d angab ctrpt (+ angab A270) (- angab PI) 1.20 2.85) ) (T (writedim d angab ctrpt (+ angab A90) angab 1.20 2.85)) ) ) ) ) (defun writedim (d azimuth ctrpt perpang orientation sp1 sp2 / textpt scalept) ;(switchl "DIMENSION") (setq textpt (polar ctrpt perpang (* (getxtht) sp1))) (setq scalePt ctrpt) (COMMAND "TEXT" "M" textpt (angtos orientation) (rtos d 2 2)) (cond (angflg (setq textpt (polar ctrpt perpang (* (getxtht) sp2))) (COMMAND "TEXT" "M" textpt (angtos orientation) (writeang (+ angab (dtr dimrotation))) ) )) (if (= (substr (getvar "CLAYER") 1 2) "34") (progn (findDetailScale) (if (and (/= nil detTxtScl)(/= 0.0 detTxtScl)) (command "SCALE" (lastn 2) "" scalept detTxtscl) (command "SCALE" (lastn 2) "" scalept theRatio) ) ) ) ; (switchl nil) ) (defun findDetailScale ( / detLayer detLen det7thLast undScr) (if (not c:lastn) (load "LASTN") ) (if (null theRatio) (progn (load "labelling") (c:detail) ) ) (setq detLayer (getvar "CLAYER")) (setq detlen (strlen detLayer)) (setq det7thLast (substr detLayer (- detLen 6))) (setq undScr (st_scan "_" det7thlast)) (setq detTxtScl (/ (* 0.001 (atoi (substr det7thLast (+ 1 undScr)))) plscale)) ) (defun writeang (azimuth) (setq azimuth (angtos azimuth 1 4)) (if (= "d" (substr azimuth 3 1)) (strcat (deg_format azimuth 3)) (if (= "d" (substr azimuth 4 1)) (strcat (deg_format azimuth 4)) (strcat (deg_format azimuth 2)) ) ) (cond ((= 5 secprec) (cond ((< 7 (last_digit seconds)) (setq seconds (additostr seconds (- 10 (last_digit seconds)))) ) ((< 2 (last_digit seconds)) (setq seconds (additostr seconds (- 5 (last_digit seconds)))) ) (T (setq seconds (additostr seconds (- 0 (last_digit seconds))))) ) (if (= (strlen seconds) 1) (setq seconds (strcat "0" seconds))) (if (= "60" seconds) (progn (setq seconds "00") (setq minutes (additostr minutes 1)) (if (= (strlen minutes) 1) (setq minutes (strcat "0" minutes))) (if (= "60" minutes) (progn (setq minutes "00") (setq degrees (additostr degrees 1)) )) )) )) (if (/= (strcase (getvar "LOGINNAME")) "Pam.hvizdos") (strcat degrees "%%d" minutes "'" seconds "\"") (strcat degrees "%%d" minutes "'" seconds "\"") ) ) (defun deg_format ( str pos) (setq degrees (substr str 1 (- pos 1))) (min_format (substr str (+ pos 1))) ) (defun min_format (str) (setq minutes (cond ((= "'" (substr str 2 1)) (sec_format (substr str 3)) (strcat"0" (substr str 1 1)) ) (T (sec_format (substr str 4)) (substr str 1 2) ) ) ) ) (defun sec_format (str) (setq seconds (substr (if ( = 2 (strlen str)) (strcat "0" str) str ) 1 2 )) ) (defun last_digit(str) (atoi (substr str (strlen str))) ) (defun additostr(str no) (itoa (+ (atoi str) no)) )
  8. I currently have a lisp routine to place a block at intersection points with one main line (RED) and then all other lines (WHITE) that cross it. I have a problem and cant seem to figure out how to adjust the code to make it work more fluid. I would like the main line to be able to be crossed more than once by a different line and still work. Currently if a RED line is crossed twice by any single white line it will not work and the lisp will bottom out and end (vl-load-com) (defun c:sbx ( / ) (progn (setq ent (car (entsel "\nSelect main line: "))) (if ent (progn (princ "\nSelect crossing line(s): ") (if (setq ss (ssget)) (progn (setq count 0 obj (vlax-ename->vla-object ent) pointlist nil ) (repeat (sslength ss) (setq xent (ssname ss count) xobj (vlax-ename->vla-object xent) ) (if (setq int (vla-IntersectWith obj xobj acExtendNone)) (progn (setq int (vlax-safearray->list (vlax-variant-value int)) pointlist (append pointlist (list int)) ) ) ) (setq count (1+ count)) ) (if (null (tblobjname "BLOCK" "SBblock")) (progn (entmake (list (cons 0 "BLOCK") (cons 2 "SBblock") (cons 70 0) (list 10 0.0 0.0 0.0))) (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (8 . "0") (100 . "AcDbPolyline") (90 . 2) (70 . 1) (43 . 1.0) (38 . 0.0) (39 . 0.0) (10 2.5 0.0) (40 . 1.0) (41 . 1.0) (42 . 1.0) (91 . 0) (10 -2.5 0.0) (40 . 1.0) (41 . 1.0) (42 . 1.0) (91 . 0) (210 0.0 0.0 1.0) ) ) (setq blockname (entmake '((0 . "ENDBLK")))) ) ) (foreach pt_nth pointlist (entmake (append '((0 . "INSERT") (100 . "AcDbEntity") (8 . "0") (100 . "AcDbBlockReference") (2 . "SBblock")) (list (cons 10 pt_nth)) '((41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0)) ) ) ) ) ) ) ) ) (princ) )
  9. Hi, First time poster so please take it easy..! I am having trouble getting my lisp to open a file, write to it then close again. I am using Lee Mac's 'LM:findfile' function. The variable 'dntxtloc' works when testing, returning a path "L:\\DESIGN\\2018\\2018-167 Commercial Road, MASLIN BEACH\\2018-167 Designer's Notes.txt" so I think the 'LM:findfile' function is working fine. It seems to fail after that, writing the 'write-line' to the command line instead and returning the error below... Command: Drawing Name is of an acceptable format20/05/2019 (Rosdun) - ; error: bad argument type: streamp nil Command: I was hoping someone might be able to help me as I'm sure it's something basic that I'm missing. Any help at all would be greatly appreciated. Snippet that seems to be the problem. (cond ( (setq dntxtloc (LM:findfile nnametxt sfpath)) ( (setq ff (open dntxtloc "a")) (write-line (strcat mydate " (" myusername ") - ") ff) (close ff) (startapp "C://Windows/Notepad.exe" dntxtloc) (princ) ) ) ( (setq dndocloc (LM:findfile nnamedoc sfpath )) ( (startapp "C://Program Files (x86)//Microsoft Office//root//Office16//WINWORD.exe" dndocloc ) (princ) ) ) (t ((alert "Designer's Notes not found...")(princ))) ); End Cond I will attach the full copy also. Regards, Ross. Open Designer's Notes V6.lsp
  10. Hello guys, I'm about to update my code in order to make it more efficient. A long time ago I wrote this function to save my custom values in an XRECORD inside a dictionary. Is it possible to have the number of parameters (300-301-302- and so on) depending on the length of the list? (DEFUN CP:salva_dati (name nomedizionario lst / dict_name anXrec) (SETQ dict_name (CP:get-or-create-Dict "C_plan")) ;(CDR (ASSOC -1 (DICTSEARCH (NAMEDOBJDICT) nomedizionario)))) (SETQ anXrec (ENTMAKEX (LIST '(0 . "XRECORD") '(100 . "AcDbXrecord") (CONS 300 (nth 0 lst)) ;percorso (CONS 301 (nth 1 lst)) ;unità (CONS 302 (nth 2 lst)) ;scala (CONS 303 (nth 3 lst)) ;scala colore (cons 304 (nth 4 lst)) ;moltiplicatore (cons 305 (nth 5 lst)) ;ang_rot ) ) ) (DICTADD dict_name name anXrec) ) (defun CP:get-or-create-Dict ( nome / adict) (if (not (setq adict (dictsearch (namedobjdict) nome))) (progn (setq adict (entmakex '((0 . "DICTIONARY")(100 . "AcDbDictionary")))) (if adict (setq adict (dictadd (namedobjdict) nome adict))) ) (setq adict (cdr (assoc -1 adict))) ) ) In this case, I can save 6 values. I want to use this function to save even only one value or 10 values without creating other dedicated functions. Is it possible? Any suggestion to accomplish that? Another question: to edit these xrecord I usually get values that don't modify and createa list of them plus values that I want to change. (setq lst (list (CP:leggi_dati "Costanti" "C_plan" 300) "M" "1" "1000" "0.01" (CP:leggi_dati "Costanti" "C_plan" 305) ) ) (dictremove (cdr (assoc -1 (dictsearch (namedobjdict) "C_plan"))) "Costanti") (CP:salva_dati "Costanti" "C_plan" lst) (DEFUN CP:leggi_dati (name nomedizionario valore / dict_name) (SETQ dict_name (CDR (ASSOC -1 (DICTSEARCH (NAMEDOBJDICT) nomedizionario)))) (CDR (ASSOC valore (DICTSEARCH dict_name name))) ) There is a better method? (modify only the element I want without collect the others) Thanks for your help! Dennis
  11. I want to be able to import 5-10 different blocks that need to be placed at approximately 70 locations each. I want to achieve this by taking a CSV file I have with the following attributes: (NAME, Xcoord, Ycoord, Zcoord) and then place the 'NAME' block at the correct coordinates within the drawing. The blocks are already preloaded within the drawing itself so they can be referenced by name.
  12. I have two polygons. One is my corridor (see white), and my other are disturbances (see red). I'm looking for a lisp that creates polygons everywhere where there is an overlap between the two (see green hatch). I currently have a lisp that gives me the area of the intersecting hatch but it is only a single use. I want to be able to click the white boundary layer and then the red intersecting layer and have it make intersecting polygons between those two.
  13. hi, any way to improve below lisp? it create new layer and new viewport but after layerp command execute the layer color goes back to white and no plot becomes plot again. (defun c:vp() (command ".layer" "M" "viewport" "C" "8" "viewport" "P" "N" "viewport" "" "-VPORTS" pause pause ".layerp") (princ) )
  14. I work as a Project Engineer with practically every one of my jobs requiring drafters to use Autocad to create drawings/plan sets. I've used Lisps for a while now and they are handy when I need to complete a task that I know I have a lisp for it helps complete the task much quicker and efficiently. The drafters I work with have 0-10 years of experience but all of which are unfamiliar with Lisp Routines. Any ideas on how to implement Lisp Routines/other useful drafting techniques into their tool-set that will help them complete plans more accurately and efficiently?
  15. I had this awesome code from Lee Mac about aligning a block to an object and wanted to know if it can be updated to also allow for the block to maintain the location and just align from the original location. This is helpful for aligning survey block to the orientation of the road line object. The code is attached to this post. LM_BlockAlign.lsp
  16. I was using code from Lee Mac but it does not seem as if I am able to edit to export object data as well or the layer the points are on. For example it currently exports into a CSV as (x,y,z). I would like it to export as (Point Layer,x,y,z) or (x,y,z,OD1,OD2,OD3) to export all the object data from each point as their own column line. Attached is Lee Mac's amazing lisp as I referenced. PtManagerV2-4.lsp
  17. I have a bunch of points with Object Data in a drawing and I need that information exported into an Excel file in the format within the Title. At the moment I have been using a workaround by importing and re-exporting and then connecting data with the Task Pane to export to excel file. Is there a lisp to better automate this process?
  18. Hello, I am trying to create a lisp routine that sets all existing MLEADERs to a certain pre-set MLEADERSTYLE, the equivalent of doing a Quick Select for Mleaders, and setting the style under the properties window. I was able to write a similar routine that selects all dimensions and sets them to a certain DIMSTYLE, using entmod and DXF code 3 for dimstyle. So far, I have not been able to find a group code for MLEADERSTYLE Any help would be greatly appreciated! (defun C:dimstylechange (/ ENTITIES NO_OF_ENTITIES SSPOSITION ENTITY_NAME OLD_ENTLIST NEW_STYLE NEW_ENTLIST) (setvar "CMDECHO" 0) (setq ENTITIES (ssget "X" '((0 . "DIMENSION")))) (setq NO_OF_ENTITIES (sslength ENTITIES)) (setq SSPOSITION 0) (repeat NO_OF_ENTITIES ;***CHANGE STYLE*** (setq ENTITY_NAME (ssname ENTITIES SSPOSITION)) (setq OLD_ENTLIST (entget ENTITY_NAME)) (setq OLD_STYLE (assoc 3 OLD_ENTLIST)) (setq NEW_STYLE (cons 3 "BCR 11x17")) (setq NEW_ENTLIST (subst NEW_STYLE OLD_STYLE OLD_ENTLIST)) (entmod NEW_ENTLIST) ;***CHANGE LAYER*** (setq OLD_ENTLIST (entget ENTITY_NAME)) (setq OLD_STYLE (assoc 8 OLD_ENTLIST)) (setq NEW_STYLE (cons 8 "DIM")) (setq NEW_ENTLIST (subst NEW_STYLE OLD_STYLE OLD_ENTLIST)) (entmod NEW_ENTLIST) (setq SSPOSITION (1+ SSPOSITION)) ) (command ".CHPROP" ENTITIES "" "C" "BYLAYER" "LT" "BYLAYER" "") (princ (strcat "\n..." (rtos NO_OF_ENTITIES 2 0) " Dimension(s) changed...")) (setvar "CMDECHO" 1) (princ) ) dimstylechange.LSP
  19. Basically, I want to select two objects, and have them displaced the same amount in opposite directions from a set point without having to do the offset command in the case that the distance may be an odd or unknown value. To summarize, I have two polylines and want to offset them away from eachother using either a typed in distance or a "point-to-point" distance like the current offset command.
  20. I have a line that crosses through multiple polygons. Is there a LISP to give me a count of how many polygons this line goes through?
  21. Hi, I have some desk drawing and I would like to add some "snap point" at the corner of my desk surface's. As they are in region, when I try using some lisp create by people who select polyline, line and all sort of line it don't work. I have about 20 500 drawing to make.*** I don't want my dwg to be in block because for the next step it won't work. Here is my dwg in witch i would like to ad point. 3-ML20366620LHRPMPM.dwg Thx
  22. Hello Please I need help with my very very old lsp program. It has been made with my colleague in around 1998-1999. Now after a long time we need to edit it to add new block tags and make it count block we specify. We have been working on it almost a week but we really dont have a clue how to edit program after that time. I am asking for a help from some good programmer to help us solve this. All help is appreciated. Lisp file content: (defun f1 () (setq pocs 1) (pp) (if (/= aaa "") (f1a) (setq pocs 0))) (defun f1a () (setq pol (assoc aaa sez)) (if (= pol nil) (f1a2) (f1a1))) (defun f1a1 () (setq cis (cdr pol)) (setq cis (+ pocs cis)) (setq pom (cons aaa cis)) (setq sez (subst pom pol sez))) (defun f1a2 () (setq sez (cons (cons aaa pocs) sez)) (setq nav nil)) (defun f2 () (setq poc (length sez)) (if (> poc 0) (fl)) (while (> poc 0) (setq prv (nth (- poc 1) sez)) (setq zna (car prv)) (setq ccc (cdr prv)) (setq spc (- 16 (strlen zna))) (setq zna (strcat zna (substr " " 1 spc) (itoa ccc))) (write-line zna s2) (write-line zna) (setq poc (- poc 1)))) (defun f3 () (setq pocs 0) (pp) (if (/= aaa "") (f3a))) (defun f3a () (setq pocs 1 pozn (strlen aaa)) (if (= pozn 1) (f1a) (f3b))) (defun f3b () (setq pzn (substr aaa 1 1)) (if (and (>= pzn "0") (<= pzn "9")) (f4a) (f6)) (f1a)) (defun f4a () (fc) (setq pzn (substr aaa 1 1)) (if (>= pzn "A") (setq pocs ccc) (f5))) (defun f5 () (setq aaa (substr aaa 2) pzn (substr aaa 1 1)) (if (>= pzn "A") (setq aaa pzn) (f6))) (defun f6 () (fd) (setq pzn (substr aaa 1 1)) (if (and (>= pzn "0") (<= pzn "9")) (f7) (setq aaa pzn))) (defun f7 () (fc) (setq aaa (substr aaa 1 1) pocs ccc)) (defun fd () (setq pzn "x") (while (and (/= pzn "(") (> pzn "")) (setq pzn (substr aaa 1 1)) (setq aaa (substr aaa 2)))) (defun fc () (setq zn "0" bbb "") (while (and (>= zn "0") (<= zn "9")) (setq bbb (strcat bbb (substr aaa 1 1))) (setq aaa (substr aaa 2)) (setq zn (substr aaa 1 1))) (setq ccc (atoi bbb))) (defun fl () (write-line nadpis) (write-line nadpis s2)) (defun fp () (setq inp (open vyso "r")) (setq out (open "lpt1" "w")) (setq q (read-line inp)) (while (/= q nil) (write-line q out) (setq q (read-line inp))) (write-line " " out) (close inp) (close out)) (defun pp () (setq n 0 zn nil) (while (/= zn " ") (setq n (+ 1 n)) (setq zn (substr aaa n 1))) (setq pzn (- n 1)) (setq aaa (substr aaa 1 pzn))) (defun f8 () (setq nadpis "***** Svitidla dle symbolu *****") (setq sez sez6) (f2)) (defun c:vypis () (textscr) (command "attext" "s" "c:/blok/vypis/material" "c:/blok/vypis/pracovni") (setq pre (getvar "dwgprefix") nam (getvar "dwgname")) (setq n (strlen nam) nn 0) (while (> n 1) (setq zn (substr nam n 1)) (if (= zn "\\") (setq nn n n 2)) (setq n (- n 1))) (setq nam (substr nam (+ nn 1))) (setq zxc (strcat pre nam ".PRN")) (princ (strcat "\nJmeno vysledneho souboru <" zxc ">\n")) (setq vyso (getstring)) (if (= vyso "") (setq vyso zxc)) (write-line " ") (setq sez1 () sez2 () sez3 () sez4 () sez5 () sez9 () sez6 () c3 0 c6 0) (setq sou (open "c:/blok/vypis/pracovni.txt" "r")) (setq rad (read-line sou)) (while (/= rad nil) (setq sez sez1) (setq aaa (substr rad 1 15)) (f1) (setq sez1 sez sez sez2) (setq aaa (substr rad 16 15)) (f1) (setq sez2 sez sez sez3) (setq aaa (substr rad 31 15)) (f3) (setq c3 (+ c3 pocs)) (setq sez3 sez sez sez4) (setq aaa (substr rad 46 15)) (f1) (setq sez4 sez sez sez5) (setq aaa (substr rad 61 15)) (f1) (setq sez9 sez sez sez9) (setq aaa (substr rad 76 15)) (f1) (setq sez5 sez sez sez6) (setq aaa (substr rad 91 15)) (f1) (setq c6 (+ c6 pocs)) (setq sez6 sez) (setq rad (read-line sou))) (close sou) (setq s2 (open vyso "w")) (setq nadpis (strcat " Vykres: " nam)) (fl) (setq nadpis "--------------Zasuvky-------------") (setq sez sez1) (f2) (setq nadpis "--------------Spinace-------------") (setq sez sez2) (f2) (setq nadpis "--------Svitidla dle popisu-------") (setq sez sez3) (f2) (setq nadpis "--------------Ostatni-------------") (setq sez sez4) (f2) (setq nadpis "--------------Ostatni-------------") (setq sez sez9) (f2) (setq nadpis "----------Ulozeni vedeni----------") (setq sez sez5) (f2) (if (/= c3 c6) (f8)) (setq nadpis "----------------------------------") (fl) (close s2) (write-line "Vytisknout na tiskarne? (A/N)") (setq ano (grread)) (if (or (equal ano '(2 65)) (equal ano '(2 97))) (fp)) (read (chr (car (cdr ano))))) Then lisp have two templates 1.material zas c01500 spin c01500 svi c01500 ost c01500 rost c01500 sve c01500 test c01500 2.pracovni ST Z24V V3 V3S VV5 VV766 TOV66 VV666 VV566 VV166 ZV1 TOV VV7 VV6 V644 VV1 Z144 TO44 V744 V544 V144 V2 V7 Z1 TOS TO V1S V51 V66 V6 V5 V1 VYN KR pc ve p boiler N2 VY V SS1 SN SN1 SS Z2 ZST ZSTA DT VYM Z3 Z1P servo SC os iz HOP zem_svorka STM vz Z1v RauchAlarm Z2p ochranaT3 ochranaT3 ochranaT3 tr nap EP1 EP2 V5144 V6644 SSm klim PKZ ZMn VYMN Zm Stlak STH pc44 258 458 158 436 236 149 128 139 124 224 pasLED LEDp LED LEDm S4 S6 S5 vz44 Tx Rx S12 S13 S21 S22 S31 S32 900 120 150 Vm Scm Scs Scv Skm Sks Skv Nkm Ncm 150 60 90 120 Zvv66 V6S VV6 VV6 VV6 VV6 VV6 VV6 VV6 VV6 VV6 VV6 VV6 VV6 VV1 VV6 VV6 VV6 VV6 VV1 S12 S12 S12 S12 S12 S12 VV6 VV6 ZV1 ZV1 ZV1 ZV1 ZV1 ZV1 ZV1 ZV1 V3S Z1 TO V1S V1 pc p boiler Z2 Z2p VYMN V6S ochranaT3 WSB4 All files in attachment. VYPIS.LSP material.txt pracovni.txt
  23. Jord_91

    Make boundary

    Hey guy's I've got this lisp that is working pretty well with an end user but when I try to add it to a script it saids that it's an Unknown command... is there something in it that is wrong? (defun lib:Zoom2Lst( vlist / bl tr Lst OS) (setq Lst (lib:pt_extents vlist) bl (car Lst) tr (cadr Lst)) (if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr))) (progn (setq OS (getvar "OSMODE"))(setvar "OSMODE" 0) (command "_.Zoom" "_Window" (trans bl 0 1)(trans tr 0 1) "_.Zoom" "0.95x") (setvar "OSMODE" OS) T) NIL)) ;External contour of objects (defun C:MakeBoundary ( / *error* blk obj MinPt MaxPt hiden pt pl unnamed_block isRus tmp_blk adoc blks lays lay oname sel csp loc sc ec ret DS osm iNSpT) (defun *error* (msg)(princ msg)(mapcar '(lambda (x) (vla-put-Visible x :vlax-true)) hiden) (vla-endundomark adoc)(if (and tmp_blk (not (vlax-erased-p tmp_blk))(vlax-write-enabled-p tmp_blk) ) (vla-Erase tmp_blk))(if osm (setvar "OSMODE" osm))(foreach x loc (vla-put-lock x :vlax-true))) (vl-load-com)(setvar "CMDECHO" 0)(setq osm (getvar "OSMODE")) (if (zerop (getvar "WORLDUCS"))(progn(vl-cmdf "_.UCS" "")(vl-cmdf "_.Plan" ""))) (setq isRus (= (getvar "SysCodePage") "ANSI_1251")) (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)) blks (vla-get-blocks adoc) lays (vla-get-layers adoc)) (vla-startundomark adoc)(if isRus (princ "\n???????? ??????? ??? ?????????? ???????")(princ "\nSelect objects for making a contour")) (vlax-for lay lays (if (= (vla-get-lock lay) :vlax-true) (progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc)))) ) (if (setq sel (ssget))(progn (setq sel (ssnamex sel)) ;;; (setq iNSpT(apply 'mapcar (cons 'min ;;; (mapcar 'cadr (apply 'append (mapcar '(lambda(x)(vl-remove-if-not 'listp x)) sel)))))) (setq iNSpT '(0 0 0)) (setq sel (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr sel)))) (setq csp (vla-objectidtoobject adoc (vla-get-ownerid (car sel)))) ; (setq unnamed_block (vla-add (vla-get-blocks adoc)(vlax-3d-point '(0. 0. 0.)) "*U")) (setq unnamed_block (vla-add (vla-get-blocks adoc)(vlax-3d-point inspt) "*U")) (foreach x sel (setq oname (strcase (vla-get-objectname x))) (cond ((member oname '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION" "ACDBMTEXT" "ACDBTEXT")) nil) ((= oname "ACDBBLOCKREFERENCE") (vla-InsertBlock unnamed_block (vla-get-insertionpoint x)(vla-get-name x) (vla-get-xscalefactor x)(vla-get-yscalefactor x) (vla-get-zscalefactor x)(vla-get-rotation x)) (setq blk (cons x blk))) (t (setq obj (cons x obj)))));_foreach (setq lay (vla-item lays (getvar "CLAYER"))) (if (= (vla-get-lock lay) :vlax-true)(progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc)))) (if obj (progn (vla-copyobjects (vla-get-activedocument (vlax-get-acad-object)) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length obj)))) obj)) unnamed_block))) (setq obj (append obj blk)) (if obj (progn ;(setq tmp_blk (vla-insertblock csp (vlax-3d-point '(0. 0. 0.))(vla-get-name unnamed_block) 1.0 1.0 1.0 0.0)) (setq tmp_blk (vla-insertblock csp (vlax-3d-point inspt)(vla-get-name unnamed_block) 1.0 1.0 1.0 0.0)) (vla-GetBoundingBox tmp_blk 'MinPt 'MaxPt) ;_??????? ????? (setq MinPt (vlax-safearray->list MinPt) MaxPt (vlax-safearray->list MaxPt) DS (max (distance MinPt (list (car MinPt)(cadr MaxPt))) (distance MinPt (list (car MaxPt)(cadr MinPt)))) DS (* 0.2 DS) ;1/5 DS (max DS 10) MinPt (mapcar '- MinPt (list DS DS)) MaxPt (mapcar '+ MaxPt (list DS DS))) (lib:Zoom2Lst (list MinPt MaxPt))(setq sset (ssget "_C" MinPt MaxPt)) (if sset (progn (setvar "OSMODE" 0) (setq hiden (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))) hiden (vl-remove tmp_blk hiden)) (mapcar '(lambda(x)(vla-put-Visible x :vlax-false)) hiden) (setq pt (mapcar '+ MinPt (list (* 0.5 DS)(* 0.5 DS)))) (vl-cmdf "_.RECTANG" (trans MinPt 0 1)(trans MaxPt 0 1)) (setq pl (vlax-ename->vla-object(entlast))) (setq sc (1-(vla-get-count csp))) (if (VL-CATCH-ALL-ERROR-P (VL-CATCH-ALL-APPLY '(lambda () (vl-cmdf "_-BOUNDARY" (trans pt 0 1) "") (while (> (getvar "CMDACTIVE") 0)(command ""))))) (if isRus (princ "\n?? ??????? ????????? ??????")(princ "\nIt was not possible to construct a contour"))) (setq ec (vla-get-count csp)) (while (< sc ec)(setq ret (append ret (list (vla-item csp sc))) sc(1+ sc))) (setq ret (vl-remove pl ret)) (mapcar '(lambda (x)(vla-Erase x)(vlax-release-object x))(list pl tmp_blk))(setq pl nil tmp_blk nil) (setq ret (mapcar '(lambda ( x / mipt)(vla-GetBoundingBox x 'MiPt nil) ;_??????? ????? (setq MiPt (vlax-safearray->list MiPt))(list MiPt x)) ret)) (setq ret (vl-sort ret '(lambda (e1 e2)(< (distance MinPt (car e1))(distance MinPt (car e2)))))) (setq pl (nth 1 ret) ret (vl-remove pl ret)) (mapcar 'vla-erase (mapcar 'cadr ret)) (mapcar '(lambda(x)(vla-put-Visible x :vlax-true)) hiden) (foreach x loc (vla-put-lock x :vlax-true)) (if pl (progn (initget "Yes No") (if (= (getkword (if isRus "\n??????? ???????? [Yes/No] <No> : " "\nDelete objects? [Yes/No] <No> : ")) "Yes") (mapcar '(lambda (x) (if (vlax-write-enabled-p x)(vla-Erase x))) obj))) (if isRus (princ "\n?? ??????? ????????? ??????")(princ "\nIt was not possible to construct a contour"))))))) (VL-CATCH-ALL-APPLY '(lambda ()(mapcar 'vlax-release-object (list unnamed_block tmp_blk csp blks lays))))));_if not (foreach x loc (vla-put-lock x :vlax-true))(setvar "OSMODE" osm) (vla-endundomark adoc)(vlax-release-object adoc)(princ)) Could you help me please!!
  24. I'm having a hard time: I'm creating a middle line in the center of a road route, to verify the distance traveled by trucks. To do this, I create a 3dpolyline by connecting the edges of the path and then create a 3D POLYLINE by clicking on the midpoint of each polyline to draw a median route. As they are many, it is being a complicated job, since I have to click on the midpoint of each one to generate the 3D line that I need. Is there any lisp that can already do this, remembering that it needs to be 3D?
  25. Hi, I'm looking to make a script, lisp or batch sort I could take all the 3D drawing from a file and convert it to a 2d drawing. I've tried a lot of thing like "flatshot", "outbounding", "flatten"... The best result was definitely with the "Flatshot" command, but it cannot be use as a script or lisp (I might be wrong). Outbounding wasn't effective at all. So I came ou with the Flatten Function from the Express tools that i run in the Wscript of Lee Mac. I made all a routine that goes like this : _open *file* _-view _top -calque nouv 2D _ai_selall _Flatten no _change tout propriétés elév 0 tout propriétés Couleur jaune _change tout propriétés ca 2D _ai_selall _-overkill terminé PURGER TOUT * NON _AUDIT OUI _-VIEW _TOP _qsave _close The fact is that the weight of the files are always too big and the details are not as accurate as "Flatshot". I could also add wblock to the script but it still a pretty heavy file So finally, I would need to take my 3D file to become a flat 2D drawing on a specific layer and color (pretty simple to do). Here's an example of the furniture i would need to "transform" 3-MLE3060EFM.dwg, the flatshot finish Flatshot.dwg and the flatten script 3-MLE3060EFM.dwg. Sorry for my bad english and just notice that the command are in french or internationnal.
×
×
  • Create New...