cadggnore Posted May 19, 2022 Posted May 19, 2022 Hi All, Does anyone know of lisp that can assist of connecting polylines to geometric centre of blocks? I need to do this on large number of drawings to acheive the connection of the polyline to the centre of the block, basically adding a vertex that connects to the centre of the block. example dwg attached Test to centre of blocks.dwg Quote
Steven P Posted May 19, 2022 Posted May 19, 2022 Fairly sure Lee Mac has something to do that on his website, but a quick look I couldn't find it I have this, from AutoCAD forums, I got it years ago before I started noting who let me have it so sorry, no credits - no problem to add credits if anyone can remind me who wrote it. (defun c:CtrCoo (/ findctr a apt) ;;Center point of a hatch or a rectangle (defun findctr (en / pt) (command "_.Zoom" "_Object" en "") (setq pt (getvar 'viewctr)) (command "_.Zoom" "_Previous") pt ) (setq a (car (entsel "Select Rectangle: : ")) apt (findctr a)) (command "_Text" "_Justify" "_MC" apt 0.1 0 apt) (princ) ) How many different blocks do you have by the way? It might be just as quick to edit the block with a point in the geometric centre (or other points) - non printing but you can connect a line to it Quote
cadggnore Posted May 19, 2022 Author Posted May 19, 2022 (edited) 5 hours ago, Steven P said: Fairly sure Lee Mac has something to do that on his website, but a quick look I couldn't find it I have this, from AutoCAD forums, I got it years ago before I started noting who let me have it so sorry, no credits - no problem to add credits if anyone can remind me who wrote it. (defun c:CtrCoo (/ findctr a apt) ;;Center point of a hatch or a rectangle (defun findctr (en / pt) (command "_.Zoom" "_Object" en "") (setq pt (getvar 'viewctr)) (command "_.Zoom" "_Previous") pt ) (setq a (car (entsel "Select Rectangle: : ")) apt (findctr a)) (command "_Text" "_Justify" "_MC" apt 0.1 0 apt) (princ) ) How many different blocks do you have by the way? It might be just as quick to edit the block with a point in the geometric centre (or other points) - non printing but you can connect a line to it Thank you Steven. I think I saw this in a forum with you & @JuniorNogueira a while back when i was searching the web for something to achieve this. I will test this out but it looks like just brings the centre text coords of a rectangle?: I have 19 to 20 different blocks, in the example attached I have put most commonly used which is 5 blocks. I have scourged Lee Macs lisps, credit to @Lee Mac. The closest I could find was what does the exact opposite of what I am trying to achieve which is http://lee-mac.com/autoblockbreak.html Also another important thing to note that my blocks are dynamic blocks in the test dwg not standard blocks. I am abandoning the thought/requiring this to go to the geometric center as it might be too hard and extra steps. I am thinking the thought process of a program to achieve this is a program that scans for the (Insertion Point/Alignment Parameter circle) of a block instead, then scans for polylines snapped to the edge of the block then adds a vertex from the edge of each polyline where it is snapped to the block boundary, then snaps that to that Insertion point of the block. Maybe that's just me thinking too much of logic of this. Edited May 19, 2022 by cadggnore 1 Quote
Steven P Posted May 20, 2022 Posted May 20, 2022 From the blocks you have in your sample the LISP above should give you the centre since they are all -nearly- rectangles 1 Quote
BIGAL Posted May 20, 2022 Posted May 20, 2022 The geometric centre is not what you want rather as the blocks appear to be rectangles you can use VL bounding box and work out the left and right mid points. Quote
Tharwat Posted May 20, 2022 Posted May 20, 2022 Its quite with many codes to cover the process correctly, would like to write it for you but I need a few encouragements. 1 Quote
cadggnore Posted May 23, 2022 Author Posted May 23, 2022 On 5/20/2022 at 6:51 PM, Steven P said: From the blocks you have in your sample the LISP above should give you the centre since they are all -nearly- rectangles That is a perfectly good idea, I am re-brainstorming the insertion point instead as it seems more achievable still working it out in steps though. Quote
cadggnore Posted May 23, 2022 Author Posted May 23, 2022 On 5/20/2022 at 7:27 PM, BIGAL said: The geometric centre is not what you want rather as the blocks appear to be rectangles you can use VL bounding box and work out the left and right mid points. Very good idea! Not all polylines will be snapped to the midpoints , some will be coming from the top/sides in different areas, I need to customise all polylines touching the bounding box, kinda how BTRIM creates a bounding box around a block to trim or BO creates a Boundary within an island of closed polyine or acad entity. Quote
cadggnore Posted May 23, 2022 Author Posted May 23, 2022 On 5/20/2022 at 9:29 PM, Tharwat said: Its quite with many codes to cover the process correctly, would like to write it for you but I need a few encouragements. Encourage! Encourage! 1 Quote
cadggnore Posted May 26, 2022 Author Posted May 26, 2022 I have tried some code at the beginning that connects polylines at insertion point of a block, but then remembered mapclean tools; Therefore, I found a way to do this if you are interested using MAP3D tools mapclean without the need of a lisp, the result is as follows though Snap to clustered Nodes feature However the part I am missing is creating the extra vertex rather than extending the existing endpoint to the insertion point. Hope this helps someone out there with my same issue as well. I will do more investigations later Quote
exceed Posted May 27, 2022 Posted May 27, 2022 (edited) ; CONNECT - 2022.05.27 exceed ; https://www.cadtutor.net/forum/topic/75205-lisp-to-connect-polylines-to-centre-or-centroid-of-blocks/ ; ; Connect the polyline connected to the border of the block by extending it to the center point of the block. ; ; Command : CONNECT ; ; To avoid errors, only fix if the polyline's first point or endpoint is inside the block. ; = It does not modify when passing or passing through a block. (vl-load-com) (defun c:CONNECT ( / ssb ssbl ssbindex 1blk 1blkobj pt1 pt2 midpt ssp sspl sspindex 1pl 1plobj 1plcoord 1plstartpt 1plcoordlen 1plendpt newcoord1 newcoord2 ) (setq ssb (ssget ":L" '((0 . "INSERT")))) (setq ssbl (sslength ssb)) (setq ssbindex 0) (repeat ssbl (setq 1blk (ssname ssb ssbindex)) (setq 1blkobj (vlax-ename->vla-object 1blk)) (vla-getboundingbox 1blkobj 'MinPt 'MaxPt) (setq pt1 (vlax-safearray->list MinPt)) (setq pt1 (list (car pt1) (cadr pt1))) (setq pt2 (vlax-safearray->list MaxPt)) (setq pt2 (list (car pt2) (cadr pt2))) (setq midpt (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1) (cadr pt2)) 2) )) ;(princ midpt) (setq ssp (ssget "C" pt1 pt2 '((0 . "LWPOLYLINE")))) (setq sspl (sslength ssp)) (setq sspindex 0) (repeat sspl (setq 1pl (ssname ssp sspindex)) (setq 1plobj (vlax-ename->vla-object 1pl)) (setq 1plcoord (vlax-safearray->list (vlax-variant-value (vlax-get-property 1plobj 'Coordinates)))) ;(princ 1plcoord) (setq 1plstartpt (list (car 1plcoord) (cadr 1plcoord))) (setq 1plcoordlen (length 1plcoord)) (setq 1plendpt (list (nth (- 1plcoordlen 2) 1plcoord) (last 1plcoord))) (setq newcoord1 '()) ; case for startpoint (cond ((and (and (>= (car 1plstartpt) (car pt1)) (<= (car 1plstartpt) (car pt2))) (and (>= (cadr 1plstartpt) (cadr pt1)) (<= (cadr 1plstartpt) (cadr pt2)))) ;(princ "\n 1pl startpt - ") ;(princ 1plstartpt) (setq newcoord1 (cons (cadr midpt) 1plcoord)) (setq newcoord1 (cons (car midpt) newcoord1)) (vlax-put 1plobj 'coordinates newcoord1) (setq 1plcoord newcoord1) ) ) (setq newcoord2 '()) ; case for endpoint (cond ((and (and (>= (car 1plendpt) (car pt1)) (<= (car 1plendpt) (car pt2))) (and (>= (cadr 1plendpt) (cadr pt1)) (<= (cadr 1plendpt) (cadr pt2)))) ;(princ " / 1pl endpt - ") ;(princ 1plendpt) (setq 1plcoord (reverse 1plcoord)) (setq newcoord2 (cons (car midpt) 1plcoord)) (setq newcoord2 (cons (cadr midpt) newcoord2)) (setq newcoord2 (reverse newcoord2)) (vlax-put 1plobj 'coordinates newcoord2) ) ) (setq sspindex (+ sspindex 1)) ) (setq ssbindex (+ ssbindex 1)) ) (princ) ) Edited May 27, 2022 by exceed 1 1 Quote
mhupp Posted May 27, 2022 Posted May 27, 2022 (edited) lol was typing something up but looks like you solved it. @exceed very nice with going to have to rember that one. (vlax-put vlaobj 'coordinates point) I'm assuming puts that at the end? Does that work with a list of points? my thing was to pull all the cords from the polyline (90 . (+1 x)) delete the original polyline entmake it back with the cords and new point. but that is so much easier. Bit easier/faster to find the midpoint with vector math (setq pt1 (vlax-safearray->list MinPt)) (setq pt2 (vlax-safearray->list MaxPt)) (setq mpt (mapcar '/ (mapcar '+ pt1 pt2) '(2 2 2))) or (setq mpt (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5))) Edited May 27, 2022 by mhupp 1 Quote
exceed Posted May 27, 2022 Posted May 27, 2022 4 minutes ago, mhupp said: lol was typing something up but looks like you solved it. @exceed very nice with going to have to rember that one. (vlax-put 1plobj 'coordinates newcoord1) my thing was to pull all the cords from the polyline (90 . (+1 x)) delete the original polyline entmake it back with the cords and new point. but that is so much easier. Bit easier/faster to find the midpoint with vector math (setq pt1 (vlax-safearray->list MinPt)) (setq pt2 (vlax-safearray->list MaxPt)) (setq mpt (mapcar '/ (mapcar '+ pt1 pt2) '(2 2 2))) or (setq mpt (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5))) It seems easier to modify a polyline as an object than an entity. you know exactly my weakness. mapcar.. Quote
mhupp Posted May 27, 2022 Posted May 27, 2022 just dumped a polyline looks like you just need to keep pumping in x and y values. Coordinates = (-260365.640983276 5723434.43573335 -260354.510190828 5723434.74702888 -260352.960611079 5723434.83370326) (setq lst ((260351.121245383 5723439.70494239 0.0) (-260346.719120515 5723437.99665513 0.0) (-260345.010833253 5723441.72532059 0.0)) (mapcar magic to make it (260351.121245383 5723439.70494239 -260346.719120515 5723437.99665513 -260345.010833253 5723441.72532059) (vlax-put vlaobj 'coordinates lst) ya mapcar is really useful and my weakness as well. Coordinates = (-260365.640983276 5723434.43573335 -260354.510190828 5723434.74702888 -260352.960611079 5723434.83370326 -260351.121245383 5723439.70494239 -260346.719120515 5723437.99665513 -260345.010833253 5723441.72532059) 1 Quote
cadggnore Posted May 27, 2022 Author Posted May 27, 2022 (edited) 41 minutes ago, exceed said: ; CONNECT - 2022.05.27 exceed ; https://www.cadtutor.net/forum/topic/75205-lisp-to-connect-polylines-to-centre-or-centroid-of-blocks/ ; ; Connect the polyline connected to the border of the block by extending it to the center point of the block. ; ; Command : CONNECT ; ; To avoid errors, only fix if the polyline's first point or endpoint is inside the block. ; = It does not modify when passing or passing through a block. (vl-load-com) (defun c:CONNECT ( / ssb ssbl ssbindex 1blk 1blkobj pt1 pt2 midpt ssp sspl sspindex 1pl 1plobj 1plcoord 1plstartpt 1plcoordlen 1plendpt newcoord1 newcoord2 ) (setq ssb (ssget ":L" '((0 . "INSERT")))) (setq ssbl (sslength ssb)) (setq ssbindex 0) (repeat ssbl (setq 1blk (ssname ssb ssbindex)) (setq 1blkobj (vlax-ename->vla-object 1blk)) (vla-getboundingbox 1blkobj 'MinPt 'MaxPt) (setq pt1 (vlax-safearray->list MinPt)) (setq pt1 (list (car pt1) (cadr pt1))) (setq pt2 (vlax-safearray->list MaxPt)) (setq pt2 (list (car pt2) (cadr pt2))) (setq midpt (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1) (cadr pt2)) 2) )) ;(princ midpt) (setq ssp (ssget "C" pt1 pt2 '((0 . "LWPOLYLINE")))) (setq sspl (sslength ssp)) (setq sspindex 0) (repeat sspl (setq 1pl (ssname ssp sspindex)) (setq 1plobj (vlax-ename->vla-object 1pl)) (setq 1plcoord (vlax-safearray->list (vlax-variant-value (vlax-get-property 1plobj 'Coordinates)))) ;(princ 1plcoord) (setq 1plstartpt (list (car 1plcoord) (cadr 1plcoord))) (setq 1plcoordlen (length 1plcoord)) (setq 1plendpt (list (nth (- 1plcoordlen 2) 1plcoord) (last 1plcoord))) (setq newcoord1 '()) ; case for startpoint (cond ((and (and (>= (car 1plstartpt) (car pt1)) (<= (car 1plstartpt) (car pt2))) (and (>= (cadr 1plstartpt) (cadr pt1)) (<= (cadr 1plstartpt) (cadr pt2)))) ;(princ "\n 1pl startpt - ") ;(princ 1plstartpt) (setq newcoord1 (cons (cadr midpt) 1plcoord)) (setq newcoord1 (cons (car midpt) newcoord1)) (vlax-put 1plobj 'coordinates newcoord1) (setq 1plcoord newcoord1) ) ) (setq newcoord2 '()) ; case for endpoint (cond ((and (and (>= (car 1plendpt) (car pt1)) (<= (car 1plendpt) (car pt2))) (and (>= (cadr 1plendpt) (cadr pt1)) (<= (cadr 1plendpt) (cadr pt2)))) ;(princ " / 1pl endpt - ") ;(princ 1plendpt) (setq 1plcoord (reverse 1plcoord)) (setq newcoord2 (cons (car midpt) 1plcoord)) (setq newcoord2 (cons (cadr midpt) newcoord2)) (setq newcoord2 (reverse newcoord2)) (vlax-put 1plobj 'coordinates newcoord2) ) ) (setq sspindex (+ sspindex 1)) ) (setq ssbindex (+ ssbindex 1)) ) (princ) ) Hi exceed, This is brilliant! Is there a small adjustment if I want the vertex to snap to the insertion point instead of the Block centre? I will give a try and get back to you! You are amazing mate Don't worry about it if it is too much hassle im still happy and very grateful for this! Edited May 27, 2022 by cadggnore 1 Quote
exceed Posted May 27, 2022 Posted May 27, 2022 (edited) 11 minutes ago, cadggnore said: Hi exceed, This is brilliant! Is there a small adjustment if I want the vertex to snap to the insertion point instead of the Block centre? I will give a try and get back to you! You are amazing mate ; CONNECT - 2022.05.27 exceed ; https://www.cadtutor.net/forum/topic/75205-lisp-to-connect-polylines-to-centre-or-centroid-of-blocks/ ; ; Connect the polyline connected to the border of the block by extending it to the center point of the block. ; ; Command List ; CONNECT - Connect to Insertion Point ; CONNECT2 - Connect to Center Point ; ; To avoid errors, only fix if the polyline's first point or endpoint is inside the block. = It does not modify when passing or passing through a block. (vl-load-com) (defun c:CONNECT ( / basept ) (setq basept "InsertionPoint") (ex:CONNECT basept) ) (defun c:CONNECT2 ( / basept ) (setq basept "CenterPoint") (ex:CONNECT basept) ) (defun ex:CONNECT ( basept / ssb ssbl ssbindex 1blk 1blkobj pt1 pt2 midpt ssp sspl sspindex 1pl 1plobj 1plcoord 1plstartpt 1plcoordlen 1plendpt newcoord1 newcoord2 ) (setq ssb (ssget ":L" '((0 . "INSERT")))) (setq ssbl (sslength ssb)) (setq ssbindex 0) (repeat ssbl (setq 1blk (ssname ssb ssbindex)) (setq 1blkobj (vlax-ename->vla-object 1blk)) (vla-getboundingbox 1blkobj 'MinPt 'MaxPt) (setq pt1 (vlax-safearray->list MinPt)) (setq pt1 (list (car pt1) (cadr pt1))) (setq pt2 (vlax-safearray->list MaxPt)) (setq pt2 (list (car pt2) (cadr pt2))) (cond ((= basept "InsertionPoint") (setq midpt (vlax-safearray->list (vlax-variant-value (vlax-get-property 1blkobj 'InsertionPoint)))) ) ((= basept "CenterPoint") (setq midpt (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1) (cadr pt2)) 2) )) ) ) ;(princ midpt) (setq ssp (ssget "C" pt1 pt2 '((0 . "LWPOLYLINE")))) (setq sspl (sslength ssp)) (setq sspindex 0) (repeat sspl (setq 1pl (ssname ssp sspindex)) (setq 1plobj (vlax-ename->vla-object 1pl)) (setq 1plcoord (vlax-safearray->list (vlax-variant-value (vlax-get-property 1plobj 'Coordinates)))) ;(princ 1plcoord) (setq 1plstartpt (list (car 1plcoord) (cadr 1plcoord))) (setq 1plcoordlen (length 1plcoord)) (setq 1plendpt (list (nth (- 1plcoordlen 2) 1plcoord) (last 1plcoord))) (setq newcoord1 '()) ; case for startpoint (cond ((and (and (>= (car 1plstartpt) (car pt1)) (<= (car 1plstartpt) (car pt2))) (and (>= (cadr 1plstartpt) (cadr pt1)) (<= (cadr 1plstartpt) (cadr pt2)))) ;(princ "\n 1pl startpt - ") ;(princ 1plstartpt) (setq newcoord1 (cons (cadr midpt) 1plcoord)) (setq newcoord1 (cons (car midpt) newcoord1)) (vlax-put 1plobj 'coordinates newcoord1) (setq 1plcoord newcoord1) ) ) (setq newcoord2 '()) ; case for endpoint (cond ((and (and (>= (car 1plendpt) (car pt1)) (<= (car 1plendpt) (car pt2))) (and (>= (cadr 1plendpt) (cadr pt1)) (<= (cadr 1plendpt) (cadr pt2)))) ;(princ " / 1pl endpt - ") ;(princ 1plendpt) (setq 1plcoord (reverse 1plcoord)) (setq newcoord2 (cons (car midpt) 1plcoord)) (setq newcoord2 (cons (cadr midpt) newcoord2)) (setq newcoord2 (reverse newcoord2)) (vlax-put 1plobj 'coordinates newcoord2) ) ) (setq sspindex (+ sspindex 1)) ) (setq ssbindex (+ ssbindex 1)) ) (princ) ) you can use both option now Edited May 27, 2022 by exceed 1 1 Quote
cadggnore Posted May 27, 2022 Author Posted May 27, 2022 6 minutes ago, exceed said: ; CONNECT - 2022.05.27 exceed ; https://www.cadtutor.net/forum/topic/75205-lisp-to-connect-polylines-to-centre-or-centroid-of-blocks/ ; ; Connect the polyline connected to the border of the block by extending it to the center point of the block. ; ; Command List ; CONNECT - Connect to Insertion Point ; CONNECT2 - Connect to Center Point ; ; To avoid errors, only fix if the polyline's first point or endpoint is inside the block. = It does not modify when passing or passing through a block. (vl-load-com) (defun c:CONNECT ( / basept ) (setq basept "InsertionPoint") (ex:CONNECT basept) ) (defun c:CONNECT2 ( / basept ) (setq basept "CenterPoint") (ex:CONNECT basept) ) (defun ex:CONNECT ( basept / ssb ssbl ssbindex 1blk 1blkobj pt1 pt2 midpt ssp sspl sspindex 1pl 1plobj 1plcoord 1plstartpt 1plcoordlen 1plendpt newcoord1 newcoord2 ) (setq ssb (ssget ":L" '((0 . "INSERT")))) (setq ssbl (sslength ssb)) (setq ssbindex 0) (repeat ssbl (setq 1blk (ssname ssb ssbindex)) (setq 1blkobj (vlax-ename->vla-object 1blk)) (vla-getboundingbox 1blkobj 'MinPt 'MaxPt) (setq pt1 (vlax-safearray->list MinPt)) (setq pt1 (list (car pt1) (cadr pt1))) (setq pt2 (vlax-safearray->list MaxPt)) (setq pt2 (list (car pt2) (cadr pt2))) (cond ((= basept "InsertionPoint") (setq midpt (vlax-safearray->list (vlax-variant-value (vlax-get-property 1blkobj 'InsertionPoint)))) ) ((= basept "CenterPoint") (setq midpt (list (/ (+ (car pt1) (car pt2)) 2) (/ (+ (cadr pt1) (cadr pt2)) 2) )) ) ) ;(princ midpt) (setq ssp (ssget "C" pt1 pt2 '((0 . "LWPOLYLINE")))) (setq sspl (sslength ssp)) (setq sspindex 0) (repeat sspl (setq 1pl (ssname ssp sspindex)) (setq 1plobj (vlax-ename->vla-object 1pl)) (setq 1plcoord (vlax-safearray->list (vlax-variant-value (vlax-get-property 1plobj 'Coordinates)))) ;(princ 1plcoord) (setq 1plstartpt (list (car 1plcoord) (cadr 1plcoord))) (setq 1plcoordlen (length 1plcoord)) (setq 1plendpt (list (nth (- 1plcoordlen 2) 1plcoord) (last 1plcoord))) (setq newcoord1 '()) ; case for startpoint (cond ((and (and (>= (car 1plstartpt) (car pt1)) (<= (car 1plstartpt) (car pt2))) (and (>= (cadr 1plstartpt) (cadr pt1)) (<= (cadr 1plstartpt) (cadr pt2)))) ;(princ "\n 1pl startpt - ") ;(princ 1plstartpt) (setq newcoord1 (cons (cadr midpt) 1plcoord)) (setq newcoord1 (cons (car midpt) newcoord1)) (vlax-put 1plobj 'coordinates newcoord1) (setq 1plcoord newcoord1) ) ) (setq newcoord2 '()) ; case for endpoint (cond ((and (and (>= (car 1plendpt) (car pt1)) (<= (car 1plendpt) (car pt2))) (and (>= (cadr 1plendpt) (cadr pt1)) (<= (cadr 1plendpt) (cadr pt2)))) ;(princ " / 1pl endpt - ") ;(princ 1plendpt) (setq 1plcoord (reverse 1plcoord)) (setq newcoord2 (cons (car midpt) 1plcoord)) (setq newcoord2 (cons (cadr midpt) newcoord2)) (setq newcoord2 (reverse newcoord2)) (vlax-put 1plobj 'coordinates newcoord2) ) ) (setq sspindex (+ sspindex 1)) ) (setq ssbindex (+ ssbindex 1)) ) (princ) ) you can use both option now Brilliant mate! Love your work. This works perfectly 1 Quote
bkishore Posted August 9 Posted August 9 while using above lisp getting below error. Please help me "connect polylines endpoints to blocks base point". "Error: bad argument type" Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.