All Activity

Hi Omar. Bienvenido Try this (defun strpto (aa / largo) (setq largo (strlen aa)) (cond ((< largo 4) aa) ((= largo 6) (strcat (substr aa 1 3) "." (substr aa 4 3))) ((= largo 7) (strcat (substr aa 1 1) "." (substr aa 2 3) "." (substr aa 5 3) ) ) (t aa) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DatosLineas : obtiene los coeficientes necesarios para determinar las ;; rectas que definen el area a cuadricular. Las cuales son ;; de la forma : a*x + b*y = c ;; (Defun DatosLineas (p1 p2 p3 p4) (setq a1 (- (cadr p2) (cadr p1)) a2 (- (cadr p4) (cadr p2)) a3 (- (cadr p3) (cadr p4)) a4 (- (cadr p1) (cadr p3)) b1 (- (car p1) (car p2)) b2 (- (car p2) (car p4)) b3 (- (car p4) (car p3)) b4 (- (car p3) (car p1)) c1 (- (* (car p1) (cadr p2)) (* (car p2) (cadr p1))) c2 (- (* (car p2) (cadr p4)) (* (car p4) (cadr p2))) c3 (- (* (car p4) (cadr p3)) (* (car p3) (cadr p4))) c4 (- (* (car p3) (cadr p1)) (* (car p1) (cadr p3))) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Punto de la recta dada por a,b,c dada la cordenada Y ;; (Defun CalculaX (a b c y) (if (= 0.0 a) ; no hay interseccion nil (/ (- c (* b y)) a) ) ) (Defun IntersecX (/ l lista) (setq l () lista (list (CalculaX a1 b1 c1 startY) (CalculaX a2 b2 c2 startY) (CalculaX a3 b3 c3 startY) (CalculaX a4 b4 c4 startY) ) ) (while (/= lista nil) (setq x (car lista)) (if (and (/= x nil) (<= x maxX) (>= x minX)) (setq l (append l (list x))) ) (setq lista (cdr lista)) ) (list (min (car l) (cadr l)) (max (car l) (cadr l))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Interseccion dada la cordenada X ;; (Defun CalculaY (a b c x) (if (= 0.0 b) ; no hay interseccion nil (/ (- c (* a x)) b) ) ) (Defun IntersecY (/ l lista) (setq l () lista (list (CalculaY a1 b1 c1 startX) (CalculaY a2 b2 c2 startX) (CalculaY a3 b3 c3 startX) (CalculaY a4 b4 c4 startX) ) ) (while (/= lista nil) (setq y (car lista)) (if (and (/= y nil) (<= y maxY) (>= y minY)) (setq l (append l (list y))) ) (setq lista (cdr lista)) ) (list (min (car l) (cadr l)) (max (car l) (cadr l))) ) (defun dameEsquinas (e / le lp) (if (= (cdr (assoc 0 (setq le (entget e)))) "LWPOLYLINE") (foreach l le (if (= (car l) 10) (setq lp (cons (cdr l) lp)) ) ) ) (if lp (vl-sort lp '(lambda(a b) (< (car a) (car b))))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Programa principal ;; (Defun c:grilla (/ p1 p2 p3 p4 paux incx incy l h n maldato base alfa startX startY minX minY maxX maxY ) (setvar "CMDECHO" 0) (command "_.undo" "_begin") (command "osnap" "off") (command "units" "2" "3" "3" "4" "e" "n") (command "LAYER" "M" "TO-GRILLA" "C" "8" "" "") (command "style" "romand" "romand" 0 1 0 "N" "N" "N") (setq incrx 0) ;;; (setq p1 (getpoint "\nIngrese un vertice de la region ") ;;; p2 (getpoint p1 "\nIngrese el otro vertice ") ;;; ) ;;; (command "LINE" p1 p2 "") (if (not (setq e (car (entsel "\nSelecciona el marco para la grilla...")))) (exit) ) (setq l (dameEsquinas e) p1 (car l) p2 (cadr l) p3 (caddr l) l nil ) (if (> (cadr p1) (cadr p2)) ; siempre el p1 abajo (setq paux p1 p1 p2 p2 paux ) ) (setq p3 (getpoint p1 "\nIngrese punto para Ancho de la region ") l (distance p1 p3) ; calculo de puntos p3 y p4 , paralelos alfa (angle p1 p2) ; a p1 y p2 a distancia l alfa (+ (/ pi 2) alfa) ) (if (> (car p3) (car p1)) (setq alfa (+ pi alfa)) ) (if (= (car p1) (car p3)) (if (< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) 0.0) (setq alfa (+ pi alfa)) ) ) (setq p3 (list (+ (car p1) (* l (cos alfa))) (+ (cadr p1) (* l (sin alfa))) ) p4 (list (+ (car p2) (* l (cos alfa))) (+ (cadr p2) (* l (sin alfa))) ) ) (command "LINE" p1 p2 p4 p3 "C") ; marco exterior (if (< (cadr p3) (cadr p1)) ; punto1 siempre mas bajo (setq paux p1 p1 p3 p3 paux paux p2 p2 p4 p4 paux ) ) (setq minX (min (car p2) (car p3)) maxX (max (car p2) (car p3)) minY (cadr p1) maxY (cadr p4) l (- maxX minX) h (- maxY minY) malDato 1 ) (while (= malDato 1) (setq incx (getreal "\nIncremento malla (m) :")) (if (< (abs (/ l 3)) incrx) (print "\nIncremento muy grande") (setq malDato 0) ) ) (setq incy incx) (setq n (fix (/ minX incx)) ; posiciones donde comenzar startX (* (1+ n) incx) ; el cuadriculado n (fix (/ minY incy)) ; tanto en X como en Y startY (* (1+ n) incy) largoMax (max (distance p1 p3) ; el largo maximo de la region (distance p1 p4) ) ) (if (< minX 0) (setq startX (- startX incx)) ) (if (< minY 0) (setq startY (- startY incy)) ) (setq ff (getreal "\nIngrese Alto (mm) :")) (setq escala (getreal "\nEscala : ")) (setq alto (* (/ ff 1000) escala)) ; alto de los caracteres (setq angP1P3 (angle p1 p3) angP1P2 (angle p1 p2) angBorde (min (abs angP1P3) (abs angP1P2)) dh (min (/ incx 40.0) (/ incy 40.0)) x1 minX ; el caso en que no hay que rotar x2 maxX y1 minY y2 maxY ) (if (or (= (cadr p1) (cadr p2)) (= (car p1) (car p3)) (= (car p1) (car p2)) ) (setq revisar 0 dl (min (/ incx 30.0) (/ incy 30.0)) ) (setq revisar 1 dl (* (* alto (/ (cos angBorde) (sin angBorde))) 2) ) ) (DatosLineas p1 p2 p3 p4) (while (< startY maxY) (if (= revisar 1) (setq ptos (IntersecX) x1 (car ptos) x2 (cadr ptos) ) ) (setq coordY (rtos startY 2 0) coordY (strcat "N-" (strpto coordY)) ) (command "LINE" (list x1 startY) (list x2 startY) "") (cond ((> (- maxY startY) (* 2 alto)) (command "TEXT" (list (+ x1 dl) (+ startY dh)) alto 0 coordY ) (command "TEXT" "R" (list (- x2 dl) (+ startY dh)) alto 0 coordY ) ) ) (setq startY (+ startY incy)) ) (while (< startX maxX) (if (= revisar 1) (setq ptos (IntersecY) y1 (car ptos) y2 (cadr ptos) ) ) (setq coordX (rtos startX 2 0) coordX (strcat "E-" (strpto coordX)) ) (command "LINE" (list startX y1) (list startX y2) "") (cond ((> (- startX minX) (* 2 alto)) (command "TEXT" (list (- startX dh) (+ y1 dl)) alto 100 coordX ) (command "TEXT" "R" (list (- startX dh) (- y2 dl)) alto 100 coordX ) ) ) (setq startX (+ startX incx)) ) (if (> (distance p1 p3) (distance p1 p2)) (setq alfa angP1P3) (setq alfa angP1P2) ) (if (or (/= alfa pi) (/= alfa 0.0)) (setq alfarad (* -1 alfa) alfa (* -1 (/ (* 200 alfa) pi)) p4 (list (- (* (car p4) (cos alfarad)) (* (cadr p4) (sin alfarad))) (+ (* (car p4) (sin alfarad)) (* (cadr p4) (cos alfarad))) ) p1 (list (- (* (car p1) (cos alfarad)) (* (cadr p1) (sin alfarad))) (+ (* (car p1) (sin alfarad)) (* (cadr p1) (cos alfarad))) ) base (list 0.0 0.0) ; el origen ) ) (command "_.undo" "end") (command "_.undo" "auto" "on") ;; (command "units" "2" "3" "3" "4" "n" "y") ) The "command" calls in your code are designed for an English version of AutoCAD, and mine is in Spanish. For this reason, and due to lack of time, I haven't tested the code sufficiently. Try it yourself and then comment on the results.

Girders run horizontally while columns are vertical. As regards all the horizontal and vertical lines it may be a result of having constructed surfaces instead of solids. I won't know for sure until I actually have a copy of your drawing. I'll send you a message with instructions.

You're welcome David, happy to help.

Also.. are my columns supposed to have those vertical/horizontal lines?

I tested your code. It does the "shutting" thing ! cool. Thanks Bigal ! I'll keep playing with it.

Hello everyone. I need to improve a Lisp routine. I've had this routine for a few years; a coworker gave it to me. It's a Lisp routine for generating a coordinate grid from a selection of three points. I need to eliminate the insertion of three points (vertices). I want to be able to select a closed polyline with a single click and generate the grid. I want to keep the entire structure of the Lisp; I only want to change the vertex selection. I should mention that I have no experience programming AutoLISP. Please, if you can help me with this. (defun strpto (aa / largo) (setq largo (strlen aa)) (cond ((< largo 4) aa) ((= largo 6) (strcat (substr aa 1 3) "." (substr aa 4 3))) ((= largo 7) (strcat (substr aa 1 1) "." (substr aa 2 3) "." (substr aa 5 3))) (t aa) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DatosLineas : obtiene los coeficientes necesarios para determinar las ;; rectas que definen el area a cuadricular. Las cuales son ;; de la forma : a*x + b*y = c ;; (Defun DatosLineas (p1 p2 p3 p4) (setq a1 (- (cadr p2)(cadr p1)) a2 (- (cadr p4)(cadr p2)) a3 (- (cadr p3)(cadr p4)) a4 (- (cadr p1)(cadr p3)) b1 (- (car p1)(car p2)) b2 (- (car p2)(car p4)) b3 (- (car p4)(car p3)) b4 (- (car p3)(car p1)) c1 (- (* (car p1)(cadr p2))(* (car p2)(cadr p1))) c2 (- (* (car p2)(cadr p4))(* (car p4)(cadr p2))) c3 (- (* (car p4)(cadr p3))(* (car p3)(cadr p4))) c4 (- (* (car p3)(cadr p1))(* (car p1)(cadr p3))) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Punto de la recta dada por a,b,c dada la cordenada Y ;; (Defun CalculaX (a b c y) (if (= 0.0 a) ; no hay interseccion nil (/ (- c (* b y)) a) ) ) (Defun IntersecX ( / l lista) (setq l () lista (list (CalculaX a1 b1 c1 startY) (CalculaX a2 b2 c2 startY) (CalculaX a3 b3 c3 startY) (CalculaX a4 b4 c4 startY) ) ) (while (/= lista nil) (setq x (car lista)) (if (and (/= x nil) (<= x maxX) (>= x minX)) (setq l (append l (list x))) ) (setq lista (cdr lista)) ) (list (min (car l)(cadr l)) (max (car l)(cadr l))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Interseccion dada la cordenada X ;; (Defun CalculaY (a b c x) (if (= 0.0 b) ; no hay interseccion nil (/ (- c (* a x)) b) ) ) (Defun IntersecY ( / l lista) (setq l () lista (list (CalculaY a1 b1 c1 startX) (CalculaY a2 b2 c2 startX) (CalculaY a3 b3 c3 startX) (CalculaY a4 b4 c4 startX) ) ) (while (/= lista nil) (setq y (car lista)) (if (and (/= y nil) (<= y maxY) (>= y minY)) (setq l (append l (list y))) ) (setq lista (cdr lista)) ) (list (min (car l)(cadr l)) (max (car l)(cadr l))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Programa principal ;; (Defun c:grilla (/ p1 p2 p3 p4 paux incx incy l h n maldato base alfa startX startY minX minY maxX maxY) (setvar "CMDECHO" 0) (command "_.undo" "_begin") (command "osnap" "off") (command "units" "2" "3" "3" "4" "e" "n") (command "LAYER" "M" "TO-GRILLA" "C" "8" "" "") (command "style" "romand" "romand" 0 1 0 "N" "N" "N") (setq incrx 0) (setq p1 (getpoint "\nIngrese un vertice de la region ") p2 (getpoint p1 "\nIngrese el otro vertice ") ) (command "LINE" p1 p2 "") (if (> (cadr p1)(cadr p2)) ; siempre el p1 abajo (setq paux p1 p1 p2 p2 paux) ) (setq p3 (getpoint p1 "\nIngrese punto para Ancho de la region ") l (distance p1 p3) ; calculo de puntos p3 y p4 , paralelos alfa (angle p1 p2) ; a p1 y p2 a distancia l alfa (+ (/ pi 2) alfa) ) (if (> (car p3) (car p1)) (setq alfa (+ pi alfa)) ) (if (= (car p1) (car p3)) (if (< (* (- (car p2)(car p1)) (- (cadr p3)(cadr p1))) 0.0) (setq alfa (+ pi alfa)) ) ) (setq p3 (list (+ (car p1)(* l (cos alfa))) (+ (cadr p1)(* l (sin alfa)))) p4 (list (+ (car p2)(* l (cos alfa))) (+ (cadr p2)(* l (sin alfa)))) ) (command "LINE" p1 p2 p4 p3 "C") ; marco exterior (if (< (cadr p3) (cadr p1)) ; punto1 siempre mas bajo (setq paux p1 p1 p3 p3 paux paux p2 p2 p4 p4 paux) ) (setq minX (min (car p2) (car p3)) maxX (max (car p2) (car p3)) minY (cadr p1) maxY (cadr p4) l (- maxX minX) h (- maxY minY) malDato 1 ) (while (= malDato 1) (setq incx (getreal "\nIncremento malla (m) :")) (if (< (abs (/ l 3)) incrx) (print "\nIncremento muy grande") (setq malDato 0) ) ) (setq incy incx) (setq n (fix (/ minX incx)) ; posiciones donde comenzar startX (* (1+ n) incx) ; el cuadriculado n (fix (/ minY incy)) ; tanto en X como en Y startY (* (1+ n) incy) largoMax (max (distance p1 p3) ; el largo maximo de la region (distance p1 p4) ) ) (if (< minX 0) (setq startX (- startX incx)) ) (if (< minY 0) (setq startY (- startY incy)) ) (setq ff (getreal "\nIngrese Alto (mm) :")) (setq escala (getreal "\nEscala : ")) (setq alto (* (/ ff 1000) escala)) ; alto de los caracteres (setq angP1P3 (angle p1 p3) angP1P2 (angle p1 p2) angBorde (min (abs angP1P3)(abs angP1P2)) dh (min (/ incx 40.0)(/ incy 40.0)) x1 minX ; el caso en que no hay que rotar x2 maxX y1 minY y2 maxY ) (if (or (= (cadr p1)(cadr p2)) (= (car p1)(car p3)) (= (car p1)(car p2))) (setq revisar 0 dl (min (/ incx 30.0)(/ incy 30.0)) ) (setq revisar 1 dl (* (* alto (/ (cos angBorde)(sin angBorde))) 2) ) ) (DatosLineas p1 p2 p3 p4) (while (< startY maxY) (if (= revisar 1) (setq ptos (IntersecX) x1 (car ptos) x2 (cadr ptos) ) ) (setq coordY (rtos startY 2 0) coordY (strcat "N-" (strpto coordY)) ) (command "LINE" (list x1 startY) (list x2 startY) "") (cond ((> (- maxY startY) (* 2 alto)) (command "TEXT" (list (+ x1 dl) (+ startY dh)) alto 0 coordY) (command "TEXT" "R" (list (- x2 dl) (+ startY dh)) alto 0 coordY) ) ) (setq startY (+ startY incy)) ) (while (< startX maxX) (if (= revisar 1) (setq ptos (IntersecY) y1 (car ptos) y2 (cadr ptos) ) ) (setq coordX (rtos startX 2 0) coordX (strcat "E-" (strpto coordX)) ) (command "LINE" (list startX y1) (list startX y2) "") (cond ((> (- startX minX) (* 2 alto)) (command "TEXT" (list (- startX dh) (+ y1 dl)) alto 100 coordX) (command "TEXT" "R" (list (- startX dh) (- y2 dl)) alto 100 coordX) ) ) (setq startX (+ startX incx)) ) (if (> (distance p1 p3) (distance p1 p2)) (setq alfa angP1P3) (setq alfa angP1P2) ) (if (or (/= alfa pi) (/= alfa 0.0)) (setq alfarad (* -1 alfa) alfa (* -1 (/ (* 200 alfa) pi)) p4 (list (- (* (car p4)(cos alfarad)) (* (cadr p4) (sin alfarad))) (+ (* (car p4)(sin alfarad)) (* (cadr p4) (cos alfarad))) ) p1 (list (- (* (car p1)(cos alfarad)) (* (cadr p1)(sin alfarad))) (+ (* (car p1)(sin alfarad)) (* (cadr p1)(cos alfarad))) ) base (list 0.0 0.0) ; el origen ) ) (command "_.undo" "end") (command "_.undo" "auto" "on") ;; (command "units" "2" "3" "3" "4" "n" "y") )

The blue were supposed to be my girders. Did I enter the dimensions incorrectly, so they're showing as columns instead of horizontal beams? This was the pic I was going off of in a previous thread that I believe you helped a lot in..

That works perfect Lee that's exactly what I was looking for... Regarding the questions about paths, the reason I chose to pass the path is because we complete drawings for various clients and most of them use similar or even the same block names with minor graphical variations, in some cases may just be attribute tag names, so I want to ensure to re-insert from that client's directory.

And I stated as much. I did get a chance to test on AutoCAD 2000i and it worked. After today I am off work for a week until next Tuesday, I'll try to look through some more options.

I also deleted your posts in the old thread you resurrected, no need for having a conversation in two separate threads.

Where did you get the UK version? This was originally Australian and USA, it was modified in 2017 for UK by www.stylemarkdesigns.co.uk (that website is no longer active). I use the original AL's Steel Mill, the Wisey's I have was last modified in 2013, that update is missing in your version. My best guess would be there is some incomplete UK data, you should look at the Aus and USA supplied data and compare.

Just installed not working

Is 'not working' a new issue or is it something that has always not worked?

You have way too many columns shown. Retain the ones in white and delete the ones in blue. You should have beams (horizontal W12x45's) running between the columns (white). And between the W12x45 beams you should have C9x20 channels running horizontally as well. See attached image below.

Found it - ;; Redefine All Blocks - Lee Mac (defun c:redefall ( / bln dir doc dwg lst obj org spc ) (setq dir nil) ;; Directory of Block Library; nil to use Support Path (if dir (setq dir (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir)) "\\")) (setq dir "") ) (cond ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer)))))) (princ "\nCurrent layer locked.") ) ( (setq doc (vla-get-activedocument (vlax-get-acad-object)) spc (vla-get-modelspace doc) org (vlax-3D-point 0 0) ) (vlax-for blk (vla-get-blocks doc) (if (and (= :vlax-false (vla-get-isxref blk)) (= :vlax-false (vla-get-islayout blk)) (not (wcmatch (setq bln (vla-get-name blk)) "`**,_*,*|*")) (setq dwg (findfile (strcat dir bln ".dwg"))) ) (progn (setq obj (vla-insertblock spc org dwg 1.0 1.0 1.0 0.0)) (if (= :vlax-true (vla-get-hasattributes obj)) (setq lst (vl-list* "," bln lst)) ) (vla-delete obj) ) ) ) (if lst (vl-cmdf "_.attsync" "_N" (apply 'strcat (cdr lst)))) (vla-regen doc acallviewports) ) ) (princ) ) (vl-load-com) (princ)

I had written & posted a 'redefine all blocks' program here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/update-blocks-amp-attributes-lisp/m-p/4423983#M315011 But for some reason I no longer appear to be able to access that thread... I'll see if I have a copy in my library.

Hi @DavidP From this part of code, you're file path is incorrect. Instend of "C:/MyBlocks/" need to be "C:/Users/"Your Name"/Desktop/MyBlocks/" or do Support File Search Path in Option -> File inside the AutoCAD to add that folder "MyBlocks". From this part of code, if I open the blank drawing where the nothing is inside, the inserted blocks "BLK1, BLK2 and BLK3" will be erased, because there isn't "oldEnt" inside the drawing. So, can you provide the drawing where you want to insert desired blocks?

Dear All, Please find attached. The wisey steel shape not working only for uk shapes.2d end view is ok, But 2d plan / 2d side not working Thanks Krishna WiseySteelShapes-UK.zip

No worries glad you got it working.

you may try to change: (command "_.-insert" blk pt s s r) (setq newEnt (entlast)) (if (and newEnt (/= oldEnt newEnt)) (entdel newEnt) ) to (command "_.-insert" (strcat (vl-filename-base blk) "=" blk) pt) (while (> (getvar "CMDACTIVE") 0) (command "")) (entdel(entlast)) ; Delete the temp insert block This will force AutoCAD to update a block from a drawing. you will need to make sure the block name is same as the DWG's name. Since you are working wirth dynamic blocks, the safer way is to get the dynamic property values for each block reference before update it and apply the data back to blocks after the definition is updated, in case dynamic parameters may have been changed in definition.

Thanks you...!

@SLW210 I tested your code on the geometry below. The solution from your code is the yellow polyline. The red lines show the correct bisector which I created from my piecemeal program mid -poly.06.lsp. Test 11-3-25.dwg

I have drawing with blocks some of which have be change by the drafters... I want to re-insert & redefine the blocks from a local folder. What I'm I missing? My blocks are Dynamic blocks.

MyBlocks.zip (defun c:foo ( / a1 a2 oldCMDECHO s r pt folderPath BlockNames oldEnt newEnt blk ) (setq oldCMDECHO (getvar "CMDECHO") a1 (getvar "ATTDIA") a2 (getvar "ATTREQ") pt (list 0.0 0.0) s 0.5 r 0.0) (setvar "CMDECHO" 0) (setvar "ATTDIA" 0) (setvar "ATTREQ" 0) (setq folderPath "C:/MyBlocks/" BlockNames (list "BLK1.dwg" "BLK2.dwg" "BLK3.dwg")) (setq oldEnt (entlast)) (foreach blk BlockNames (setq blk (strcat folderPath blk)) (command "_.-insert" blk pt s s r) (setq newEnt (entlast)) (if (and newEnt (/= oldEnt newEnt)) (entdel newEnt) ) ) (setvar "ATTDIA" a1) (setvar "ATTREQ" a2) (setvar "CMDECHO" oldCMDECHO) (princ "\nBlocks inserted successfully.") (princ) )

I have improved mine somewhat, at least it's the same no matter the pick order. Still working on a better method for correct centerline. Looks pretty close most of the time and should work with LWPolylines and Old Style Polylines and should handle bulges. I finished this at work, so untested on AutoCAD 2000i at home, so just AutoCAD 2026. ;;; Draws a centerline between two polylines. | ;;; | ;;; https://www.cadtutor.net/forum/topic/98778-hybrid-parallel/page/3/#findComment-677003 | ;;; | ;;; By SLW210 (a.k.a. Steve Wilson) | ;;; | ;;;=======================================================================================| ;;; DrawCl.LSP | ;;; Create centerline between two polylines | ;;; on layer Centerline, color Blue, and linetype Center | ;;;=======================================================================================| (vl-load-com) ;;; ------------------------------- ;;; Vector midpoint ;;; ------------------------------- (defun v-mid (a b) (list (/ (+ (car a) (car b)) 2.0) (/ (+ (cadr a) (cadr b)) 2.0)) ) ;;; ------------------------------- ;;; Distance squared ;;; ------------------------------- (defun dist2 (a b) (+ (expt (- (car a) (car b)) 2) (expt (- (cadr a) (cadr b)) 2)) ) ;;; ------------------------------- ;;; Nearest point ;;; ------------------------------- (defun nearest (pt lst / best d cur) (setq best nil d 1e99) (foreach cur lst (if (< (dist2 pt cur) d) (setq d (dist2 pt cur) best cur))) best ) ;;; -------------------------------------------------- ;;; Get polyline vertices (LWPOLYLINE or old POLYLINE) ;;; -------------------------------------------------- (defun get-poly-pts (ename / elist pts cur) (setq elist (entget ename)) (cond ((= "LWPOLYLINE" (cdr (assoc 0 elist))) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) elist))) ((= "POLYLINE" (cdr (assoc 0 elist))) (setq pts '() cur (entnext ename)) (while cur (setq elist (entget cur)) (cond ((= "VERTEX" (cdr (assoc 0 elist))) (setq pts (cons (cdr (assoc 10 elist)) pts))) ((= "SEQEND" (cdr (assoc 0 elist))) (setq cur nil))) (if cur (setq cur (entnext cur)))) (reverse pts)) (T (progn (princ "\nEntity is not a polyline.") nil))) ) ;;; ----------------------------------------- ;;; Polyline length (sum of vertex distances) ;;; ----------------------------------------- (defun polyline-length (pts / total i) (if (< (length pts) 2) 0 (progn (setq total 0.0 i 0) (while (< i (1- (length pts))) (setq total (+ total (sqrt (dist2 (nth i pts) (nth (1+ i) pts))))) (setq i (1+ i))) total))) ;;; ------------------------------- ;;; Polyline selection helper ;;; ------------------------------- (defun select-polyline (pick / sel) (while (progn (setq sel (entsel pick)) (not (and sel (entget (car sel))))) (princ "\nPlease select a valid polyline.")) (car sel)) ;;; ------------------------------- ;;; Ensure Centerline Layer Exists ;;; ------------------------------- (defun ensure-centerline-layer (/ doc layers layerObj ltObj) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))) (setq layers (vla-get-Layers doc)) (setq ltypes (vla-get-Linetypes doc)) ;; Load CENTER linetype if needed (if (not (tblsearch "LTYPE" "CENTER")) (vl-catch-all-apply '(lambda () (vla-load ltypes "CENTER" "acad.lin")))) ;; Create layer if missing (if (not (tblsearch "LAYER" "Centerline")) (setq layerObj (vla-Add layers "Centerline")) (setq layerObj (vla-Item layers "Centerline"))) ;; Set layer properties (vla-put-Color layerObj 5) ; blue (if (tblsearch "LTYPE" "CENTER") (vla-put-Linetype layerObj "CENTER")) layerObj ) ;;; ------------------------------- ;;; Main DRAWCL command ;;; ------------------------------- (defun c:DRAWCL (/ e1 e2 pts1 pts2 ref tgt mids coords arr doc ms pline closest closed layerObj) (vl-load-com) (princ "\nStarting DRAWCL centerline routine...") ;; Select polylines (setq e1 (select-polyline "\nSelect first polyline: ")) (setq e2 (select-polyline "\nSelect second polyline: ")) ;; Get vertices (setq pts1 (get-poly-pts e1)) (setq pts2 (get-poly-pts e2)) (if (and pts1 pts2) (progn ;; Determine longer polyline as reference (if (> (polyline-length pts1) (polyline-length pts2)) (setq ref pts1 tgt pts2 eRef e1) (setq ref pts2 tgt pts1 eRef e2)) ;; Compute centerline midpoints (setq mids '()) (foreach pt ref (setq closest (nearest pt tgt)) (setq mids (cons (v-mid pt closest) mids))) (setq mids (reverse mids)) ;; Ensure Centerline layer and linetype exist (setq layerObj (ensure-centerline-layer)) ;; Create centerline polyline in model space (if (> (length mids) 1) (progn (setq coords (apply 'append (mapcar '(lambda (p) (list (car p) (cadr p))) mids))) (setq arr (vlax-make-safearray vlax-vbDouble (cons 0 (- (* 2 (length mids)) 1)))) (vlax-safearray-fill arr coords) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))) (setq ms (vla-get-ModelSpace doc)) (setq pline (vla-AddLightWeightPolyline ms arr)) ;; Match closed/open status (setq closed (= 1 (logand 1 (cdr (assoc 70 (entget eRef)))))) (vla-put-Closed pline (if closed :vlax-true :vlax-false)) ;; Assign layer (vla-put-Layer pline "Centerline") (princ "\nCenterline created successfully on layer 'Centerline'.")) (princ "\nNot enough points to create centerline."))) (princ "\nFailed to get polyline vertices.")) (princ) ) Most Civil software has this in it and works pretty good AFAIK most of the time, it's not using LISP. It might be the harder, but maybe for new AutoCAD using CENTERLINE command with automated trimming and Join and Close if needed might be best for accuracy.