Search the Community

Colleagues, best regards. Today I come to ask for help. I have developed a routine that splits a polygon based on the location of the origin of the blocks above it; However, the selection takes into account other blocks that overlap only slightly in the polygon, allowing me to run the routine anyway but with an undesired result. I can remove the blocks manually, but when there are too many it becomes very tedious and time-consuming. I want to know if there is a way to avoid these external blocks that alter the results of my routine. In the attached dwg I present 2 cases, in the one on the right the routine works without problems, however in the one on the left the complication occurs with the blocks external to the polygon but that still overlap a little. Another complication that arises is when the polygon presents an arc. Attached dwg and lisp file I am very grateful for the help and attention provided. ORIGENpl.lsp SEGMENTACION.dwg

Hi. I am a newbie with Lisps. But was just wondering if there is an existing lisp out there to explode all blocks (both model space and paper space) except for blocks in this layer "A3_TT"? I am trying to look for a routine cause I need to apply it to almost thousands of drawings. Any help would be much appreciated. Best regards, William

HI, I need to create a Lisp to do the following in a series of drawings within a folder and then save as a new file. Superflatten entire drawing. Audit and fix errors. overkill entire drawing Convert all. Purge all. Remove Hatching. Remove DIms. Create boundary box from most southern and most western extremities of building. move boundary box and content from basepoint to be 2000,2000 from 0,0. Id like to type "deepclean" as command in future, I have over 1000 drawings to run this on so ideally id like to find a routine which will automatically do this to all files within a folder, without the need to manually open each one?

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.

How are you. I'm pretty simple with Lisp programming, but develop a routine for my needs I'm having problems with restoring variables; since if the user presses the esc key the variables are not reset at the end of the routine. Can someone help me with error control? I would be very grateful. I attached the routine. ;guarda y establece variables origen________________________________________________________________ (defun s_var (/ gvtho gvomo gvlco) (setq gvtho (getvar "textsize"));Guarda variable text h (setq gvomo (getvar "orthomode"));Guarda variable orthomode (setq gvlco (getvar "clayer"));Guarda variable layer current (setvar 'orthomode 1) (setvar 'tspacefac 1) (setvar 'luprec 2) );endd ;restaura variables de origen (defun r_var () (setvar 'textsize gvtho) (setvar 'orthomode gvomo) (setvar 'clayer gvlco));endd ;Crea y/o establece el layer actual en "_OFFSET Y NIVELES" ____________________________________________ (defun n_lay ( ) (command "._layer" "_M" "_OFFSET Y NIVELES" "_C" "7" "" "") (setvar "clayer" "_OFFSET Y NIVELES"));end ;Preguntar al usuario si el estio tiene Altura_____________________________________________________________________________ (defun q_estion () (initget "Si No") (setq eath (getkword "\nESTILO DE TEXTO ACTUAL TIENE ALTURA? [Si/No] <Si>: "));Estilo actual tiene H (if (= eath "No") (ts) );end if );end ;establece altura de texto cuando el estilo no lo tiene______________________________________________ (defun ts (/ ph) (setq dnht (getdist "\nAltura de Texto: <0.18>: "); Define Nueva H texto dnht (if (null ph) 0.18 ph)) (setvar 'textsize dnht) );end ;if YTN=____________________________________________________________________________________ (defun ytn ( ) (while (setq wpy (getpoint "\nQUE PUNTO: ")) (setq p1y (cadr wpy)) ;coordinada en y (setq v1y (rtos p1y 2 2)) (setq m1y (strcat "TN= " v1y )) (setq t1y (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1y "j" "ml" "r" "90" "w" "0" m1y "") (command "_.move" "l" "" t1y (cons (- (car t1y) -0.17) (cdr t1y))) );while );end ;if YG=____________________________________________________________________________________ (defun yg ( ) (while (setq wpy (getpoint "\nQUE PUNTO: ")) (setq p1y (cadr wpy)) ;coordinada en y (setq v1y (rtos p1y 2 2)) (setq m1y (strcat "G= " v1y )) (setq t1y (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1y "j" "ml" "r" "90" "w" "0" m1y "") (command "_.move" "l" "" t1y (cons (- (car t1y) -0.17) (cdr t1y))) );while );end ;if YB=____________________________________________________________________________________ (defun yb ( ) (while (setq wpy (getpoint "\nQUE PUNTO: ")) (setq p1y (cadr wpy)) ;coordinada en y (setq v1y (rtos p1y 2 2)) (setq m1y (strcat "B= " v1y )) (setq t1y (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1y "j" "ml" "r" "90" "w" "0" m1y "") (command "_.move" "l" "" t1y (cons (- (car t1y) -0.17) (cdr t1y))) );while );end ;if YNC=____________________________________________________________________________________ (defun ync ( ) (while (setq wpy (getpoint "\nQUE PUNTO: ")) (setq p1y (cadr wpy)) ;coordinada en y (setq v1y (rtos p1y 2 2)) (setq m1y (strcat "NC= " v1y )) (setq t1y (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1y "j" "ml" "r" "90" "w" "0" m1y "") (command "_.move" "l" "" t1y (cons (- (car t1y) -0.17) (cdr t1y))) );while );end ;if YMC=____________________________________________________________________________________ (defun ymc ( ) (while (setq wpy (getpoint "\nQUE PUNTO: ")) (setq p1y (cadr wpy)) ;coordinada en y (setq v1y (rtos p1y 2 2)) (setq m1y (strcat "MC= " v1y )) (setq t1y (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1y "j" "ml" "r" "90" "w" "0" m1y "") (command "_.move" "l" "" t1y (cons (- (car t1y) -0.17) (cdr t1y))) );while );end ;if YOTRO_________________________________________________________________________________ (defun yotro (/ dpry ) (setq dpry (getstring t "\nQue prefijo: <R>: ") dpry (if (null dpry)R dpry)) (while (setq wpy (getpoint "\nQUE PUNTO: ")) (setq p1y (cadr wpy)) ;coordinada en y (setq v1y (rtos p1y 2 2)) (setq m1y (strcat dpry "= " v1y )) (setq t1y (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1y "j" "ml" "r" "90" "w" "0" m1y "") (command "_.move" "l" "" t1y (cons (- (car t1y) -0.17) (cdr t1y))) );while );end ;lllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllll ;if TN=____________________________________________________________________________________ (defun xtn ( ) (while (setq wpx (getpoint "\nQUE PUNTO: ")) (setq p1x (car wpx)) ;coordinada en x (setq p2x (cadr wpx)) ;coordinada en y (setq v1x (rtos p1x 2 2)) (setq v2x (rtos p2x 2 2)) (setq m1x (strcat "OFF= " v1x )) (setq m2x (strcat "TN= " v2x )) (setq t1x (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1x "j" "ml" "r" "90" "w" "0" m1x m2x "") );while );end ;if G=____________________________________________________________________________________ (defun xg ( ) (while (setq wpx (getpoint "\nQUE PUNTO: ")) (setq p1x (car wpx)) ;coordinada en x (setq p2x (cadr wpx)) ;coordinada en y (setq v1x (rtos p1x 2 2)) (setq v2x (rtos p2x 2 2)) (setq m1x (strcat "OFF= " v1x )) (setq m2x (strcat "G= " v2x )) (setq t1x (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1x "j" "ml" "r" "90" "w" "0" m1x m2x "") );while );end ;if B=____________________________________________________________________________________ (defun xb ( ) (while (setq wpx (getpoint "\nQUE PUNTO: ")) (setq p1x (car wpx)) ;coordinada en x (setq p2x (cadr wpx)) ;coordinada en y (setq v1x (rtos p1x 2 2)) (setq v2x (rtos p2x 2 2)) (setq m1x (strcat "OFF= " v1x )) (setq m2x (strcat "B= " v2x )) (setq t1x (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1x "j" "ml" "r" "90" "w" "0" m1x m2x "") );while );end ;if NC=____________________________________________________________________________________ (defun xnc ( ) (while (setq wpx (getpoint "\nQUE PUNTO: ")) (setq p1x (car wpx)) ;coordinada en x (setq p2x (cadr wpx)) ;coordinada en y (setq v1x (rtos p1x 2 2)) (setq v2x (rtos p2x 2 2)) (setq m1x (strcat "OFF= " v1x )) (setq m2x (strcat "NC= " v2x )) (setq t1x (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1x "j" "ml" "r" "90" "w" "0" m1x m2x "") );while );end ;if NU=____________________________________________________________________________________ (defun xnu ( ) (while (setq wpx (getpoint "\nQUE PUNTO: ")) (setq p1x (car wpx)) ;coordinada en x (setq v1x (rtos p1x 2 2)) (setq m1x (strcat "OFF= " v1x )) (setq t1x (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1x "j" "ml" "r" "90" "w" "0" m1x "") (command "_.move" "l" "" t1x (cons (- (car t1x) 0.14) (cdr t1x))) );while );end ;if MC=____________________________________________________________________________________ (defun xmc ( ) (while (setq wpx (getpoint "\nQUE PUNTO: ")) (setq p1x (car wpx)) ;coordinada en x (setq p2x (cadr wpx)) ;coordinada en y (setq v1x (rtos p1x 2 2)) (setq v2x (rtos p2x 2 2)) (setq m1x (strcat "OFF= " v1x )) (setq m2x (strcat "MC= " v2x )) (setq t1x (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1x "j" "ml" "r" "90" "w" "0" m1x m2x "") );while );end ;if XOTRO=____________________________________________________________________________________ (defun xotro (/ dprx ) (setq dprx (getstring t "\nQue prefijo: <R>: ") dprx (if (null dprx) R= dprx)) (while (setq wpx (getpoint "\nQUE PUNTO: ")) (setq p1x (car wpx)) ;coordinada en x (setq p2x (cadr wpx)) ;coordinada en y (setq v1x (rtos p1x 2 2)) (setq v2x (rtos p2x 2 2)) (setq m1x (strcat "OFF= " v1x )) (setq m2x (strcat dprx "= " v2x )) (setq t1x (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1x "j" "ml" "r" "90" "w" "0" m1x m2x "") );while );end ;OK_Y___________________________________ (defun C:vy (/ opry pwy p1y v1y m1y t1y) (s_var) (n_lay) (initget "TN R G B NC MC OTRO") (setq opry (getkword "\nPREFIJO EN Y [TN/R/G/B/NC/MC/OTRO] <R>: ")) (q_estion) (if (= opry "TN") (ytn) );end if (if (= opry "G") (yg) );end if (if (= opry "B") (yb) );end if (if (= opry "NC") (ync) );end if (if (= opry "MC") (ymc) );end if (if (= opry "OTRO") (yotro) );end if (while (setq wpy (getpoint "\nQUE PUNTO: ")) (setq p1y (cadr wpy)) ;coordinada en y (setq v1y (rtos p1y 2 2)) (setq m1y (strcat "R= " v1y )) (setq t1y (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1y "j" "ml" "r" "90" "w" "0" m1y "") (command "_.move" "l" "" t1y (cons (- (car t1y) -0.17) (cdr t1y))) );while (r_var) (princ) );end ;OK_XY___________________________________________________ (defun C:vxy (/ oprx wpx p1x p2x v1x v2x m1x m2x t1x t2x) (s_var) (n_lay) (initget "TN NU R G B NC MC OTRO") (setq oprx (getkword "\nOFFEST + PREFIJO EN Y [TN/NU/R/G/B/NC/MC/OTRO] <R=>: ")) (q_estion) (if (= oprx "TN") (xtn) );end if (if (= oprx "R") (xr) );end if (if (= oprx "G") (xg) );end if (if (= oprx "B") (xb) );end if (if (= oprx "NC") (xnc) );end if (if (= oprx "MC") (xmc) );end if (if (= oprx "NU") (xnu) );end if (if (= oprx "OTRO") (xotro) );end if (while (setq wpx (getpoint "\nQUE PUNTO: ")) (setq p1x (car wpx)) ;coordinada en x (setq p2x (cadr wpx)) ;coordinada en y (setq v1x (rtos p1x 2 2)) (setq v2x (rtos p2x 2 2)) (setq m1x (strcat "OFF= " v1x )) (setq m2x (strcat "R= " v2x )) (setq t1x (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1x "j" "ml" "r" "90" "w" "0" m1x m2x "") );while (r_var) (princ) );end

i'm looking for a simple area routine base on the dimension not the line. i want to be able to click on 2 cotation that i got from the dimlinear command and have the area "print" in a text format where i want to. I know a routine with a lot of visual lisp routine in it, but i'm looking a version with a standard/ basic lisp. thank you.

Hello everybody! Few programmers (including myself) decided to create a website with free (for now) AutoLisp programs and scripts for Autocad. Well, we have few questions to define where to start. Your answers would really help. - Do you use programs (scripts) in your work? - Which program (script) you would use but do not have. Best regards, ... PS Link to website asap

Hi, brand new to this site and my very first thread! I am trying to write a LISP routine and basically have no experience with it except for opening them up and trying to decode it for my self. I am going over lisp basics right now but thought I would through this out there in hopes of learning something from you fine folks. What I need to do is draw a series of circles and rectangles and label them from values in a .CSV file. As I mentioned I am going over the basics and am having trouble keeping my head above water, so be kind please. Thanks in advance, CADINATOR

Hi, I use LT most of the time, every now and then I need to run a Lisp Routine. So I save the file into my old version of AutoCAD Full... Run the Lisp Routine. It would be so much more convenient to just run it in LT Thanks for any help.

I have a number of drawings with levels on (single line and multitext) which are currently set to a local datum and I need to amend all to ordnance datum. To help reduce the time involved to do this I am looking for lisp routine that can find levels which are to 3 decimal places and add a set figure to it. (ie add 0.57m to every level on the drawing. Thanks for your help in advance

I am trying to update menses, tools, and LISP routines from autoCAD 2000 to 2011. I was able to load and update most of them except 4 LISP routines. When I open the routine in VisualLISP all I get is a bunch of characters. It does not matter if I use autoCAD 2000 or 2011 to open the routines, it would not show its content. Does anyone know what might be the issue? How to fix it? Thanks

Hi all first of all thanks to everyone for all the help in the past, a really cool community here, hopefully one day i have the knowlede to return the favour. maybe i could shout a six pack of ausie beer some time. I am working on a road design with a whole set of drawings that have about 10 -15 xrefs, for example pavement hatch, contours, detailed survey, cadastral, design, ret walls, drainage layout, survey ug services, tcs layouts, utilities, utilities (current theme), survey bdy, prop bdy, plan control, text notes. this is the order i need the xrefs in, but some drawings have more or less xrefs than others. can anyone suggest a way i could put these in order rather than individually picking a line from an xref and sending it to the back, over and over again? i thought maybe a table where i number the order next to the xref name. Im new to this lisp routine so please be gentle. Cheers Marcus

Hi All, I need some help i have three lisp routines that i would like to combine into one routine. they all use the same objects to get their results so i was wondering if there was a way to combine them together. the order of would be as follows: 1. olo (Offset Polylines) 2. exl (Extrusion Lengths) the only that i see with this one is that it requires use input for placement, i would for it to place the results to the outside of lines. run the lisp routine by creating a rectangle exploded to see what it does. 3. pte (Panel Tab Extension) They all run perfectly by themselves, but im just trying to speed up the process. Here are the codes that i'm using. any help would be appreciated. Thanks, Brian ;| OFFSET POLYLINES [email="mfuccaro@hotmail.com"]mfuccaro@hotmail.com[/email] September 2003 |; (defun c:olo( / plines ; selection set of polylines ext ; extrnal point dist ; distance to offset poly ; a polyline from plines plist ; the list of poly del ; polyline to delete int ; internal point i) (command "undo" "begin") (princ "select polylines") (setq plines (ssget) i 0 ext (getvar "limmax") dist (getdist (strcat "distance <" (if olddist (rtos olddist) ;use old value as default "") ">"))) (if (not dist) (setq dist olddist)) ;reuse old distance if user press <Enter> (repeat (sslength plines) (setq poly (ssname plines i)) (setq plist (entget poly)) (command "offset" dist poly ext "") (setq del (entlast) int (polar (cdr (assoc 10 (entget del))) (angle (cdr (assoc 10 (entget del))) (cdr (assoc 10 plist))) (* 2 (distance (cdr (assoc 10 plist)) (cdr (assoc 10 (entget del))))))) (command "offset" dist poly int "") (command "_.change" (entlast) "" "_p" "_la" (getvar 'clayer) "") (entdel del) (setq i (1+ i))) (command "undo" "end") (setq olddist dist) ;preserve current distance for next run (princ) ) ;Extrusion Length (defun c:EXTL (/ cEnt tStr tBox tHgt tWid gr sPt cPt lAng bPt tPt pt1 pt2 pt3 pt4) (vl-load-com) (if (and (setq cEnt (car (entsel "\nSelect Object: "))) (member (cdr (assoc 0 (entget cEnt))) '("LWPOLYLINE" "POLYLINE" "LINE"))) (progn (setq tStr (strcat "1@" (rtos (- (vla-get-length (vlax-ename->vla-object cEnt)) 4.0)) (strcat "''")) tBox (textbox (list (cons 1 tStr) (cons 40 (getvar "TEXTSIZE")))) tHgt (- (cadadr tBox) (cadar tBox)) twid (- (caadr tBox) (caar tBox))) (princ "\nPosition Text...") (while (eq 5 (car (setq gr (grread t 5 0)))) (redraw) (if (listp (setq sPt (cadr gr))) (progn (setq cPt (vlax-curve-getClosestPointto cEnt sPt) lAng (angle cPt sPt) bpt (polar cPt lAng (/ (getvar "TEXTSIZE") 2.)) tpt (polar bpt lAng tHgt) mPt (polar bPt lAng (/ tHgt 2.)) pt1 (polar bpt (+ lAng (/ pi 2.)) (/ tWid 2.)) pt2 (polar bPt (- lAng (/ pi 2.)) (/ tWid 2.)) pt3 (polar tpt (+ lAng (/ pi 2.)) (/ tWid 2.)) pt4 (polar tPt (- lAng (/ pi 2.)) (/ tWid 2.))) (grvecs (list -3 pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4))))) (if (eq 3 (car gr)) (progn (setq lAng (- lAng (/ pi 2.))) (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (Make_Text mPt tStr lAng)))) (princ "\n<!> Incorrect Selection <!>")) (redraw) (princ)) (defun Make_Text (pt val rot) (entmake (list (cons 0 "TEXT") (cons 8 (getvar "CLAYER")) (cons 62 1) (cons 10 pt) (cons 40 (getvar "TEXTSIZE")) (cons 1 val) (cons 50 rot) (cons 7 (getvar "TEXTSTYLE")) (cons 71 0) (cons 72 1) (cons 73 2) (cons 11 pt)))) ;;; PANEL TAB EXTENSIONS (defun c:PTE(/ lSet actDoc lDel doMode objLst) (vl-load-com) (princ "\n>>> Select lines to extend/reduce <<< ") (if (and (setq lSet (ssget '((0 . "LINE")))); (setq lDel (getreal "\nSpecify : ")) ); end and (progn (initget 1 "Positive Negative Both") (setq doMode (getkword "\nSpecify direction [Positive/Negative/Both]: ") objLst(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr(ssnamex lSet))))); end setq (vla-StartUndoMark (setq actDoc (vla-get-ActiveDocument (vlax-get-acad-object)))); end vla-StartUndoMark (if(member doMode '("Negative" "Both")) (foreach ln objLst (vlax-put ln 'startpoint (polar (vlax-get ln 'startpoint) (vlax-get ln 'angle)(- lDel))); end vlax-put ); end foreach ); end if (if(member doMode '("Positive" "Both")) (foreach ln objLst (vlax-put ln 'endpoint (polar (vlax-get ln 'endpoint) (vlax-get ln 'angle)lDel)) ); end foreach ); end if (vla-EndUndoMark actDoc) ); end progn ); end if (princ) )