Jump to content

Search the Community

Showing results for tags 'lisp'.

  • 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. Hello, I apologize if my terminology is off as I generally do not work in CAD/LISP. I am working on a lisp routine that draws blocks and adds attributes to the blocks (labels). I set the blocks to be a solid hatch and set their colour with (setvar "cecolor" "255"). After I finished I realized it would be nice to add the ability to draw the blocks without fill if the user wishes. I thought their would be a system variable something like (setvar "transparency" "100") but I can't find anything. Does anyone know how to set the transparency of block fill using LISP or how to set the colour to NULL? Thanks
  2. Good Morning All, All of our drawings are produced in 2D AutoCAD, generally building elevations, roof plans and sectional details. What I want to be able to do is measure a dimension on the plan of a roof, but, use a lisp to apply a factor to this so that the output dimension shows the length at the pitch of the roof... In other words if the plan dimension was 5000mm, but the roof pitch was known to be 10 degrees, the output of that dimension would show 5077mm. Or, at 15 degrees, the output would show 5176mm, etc, etc. What I would also like to do is apply this lisp individually or to a group of dimensions. Hope this makes sense!!
  3. I am looking for a routine to sort contour lines. I am using 3d polylines that I import from Global Mapper. My problem is all of the lines are on one layer. Ideally, I would like to pick a starting elevation (polyline) and have the routine select every 5th contour up and down. Once then are all selected, I can move them to a new layer (like TOPO-INDEX). Some of these sites are hundreds of acres and have significant elevation changes. To do this by hand is VERY time-consuming (and easy to miss some contours). I am not a programmer, but this seems like the type of task that is ideal for a lisp routine. Any help is appreciated.
  4. Hi All Members Please Please help me for text on Polyline with block Sorry for English S2_A1_CS_LIST_FINAL.dwg
  5. Hello all, I work for a Firm that does Commercial Architectural Drafting and I am currently looking for a simple way to add a lisp routine that allows us to automatically calculate New doors on Floor plans and Parking Spaces on site plans that we create. Reason being that we are just looking for a faster way to do this without counting each individual door or parking space to save time and energy. Not sure if this is possible because I do not have extensive knowledge in Lisp Routines but this seemed like the right place to ask. If anyone knows anything about this that would be helpful. Thank you and have a great day.
  6. Dear Team, Greetings..! I have multiple drawings in one .dwg file in Model (Ref. UNIT 4500.JPG file). I need to covert PDF's with help of "Page Setup Name" Each name Plot area selected. (Ref. Page Setup.jpg file). the converted pdf file with name of same as Page setup name & automatically saved in WRT to Unit path.(Ref. Path.JPG) Kindly help me out I have hundreds of drawing to covert every time of small correction..!!
  7. 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) )
  8. 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.
  9. 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
  10. 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"
  11. 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)) )
  12. 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) )
  13. 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
  14. 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.
  15. 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.
  16. 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) )
  17. 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?
  18. 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
  19. 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?
  20. 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
  21. 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.
  22. 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?
  23. 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
  24. 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
  25. 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!!
×
×
  • Create New...