Leaderboard

; 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

; 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) )

Explain more need dwg or images at least.

Brilliant mate! Love your work. This works perfectly

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!

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)

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)))

; ECT - 2022.05.26 exceed ; https://www.cadtutor.net/forum/topic/75239-combine-text-and-export/ ; - what is this ; Text content is concatenated between texts close to each other. ; ; - how to use ; 1. select a group of text twice. ; 2. overwriting the text of the 1st selected group. ; ; - note ; 1. Because it simply works on distance-based, ; It's not a 1:1 pair. For example, if text group2 is less than group1, the closest group2 is copied. ; 2. If there is text with overlapping positions, it may not work properly. (vl-load-com) (defun c:ECT ( / ss ssl index1 ss1list obj1 coord1 list1 ss2 ss2l index2 ss2list obj2 coord2 list2 pairstack index11 coord11 index22 coord22 dist12 distlist distmin pslen psindex txt1 txt2 puttxt ) (princ "\n pick 1st group of text") (setq ss (ssadd)) (setq ss (ssget ":L" '((0 . "*TEXT")))) (setq ssl (sslength ss)) (if (/= ssl 0) (progn (setq index1 0) (setq ss1list '()) ;make 1st list (repeat ssl (setq obj1 (vlax-ename->vla-object (ssname ss index1))) (setq coord1 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj1 'InsertionPoint)))) (setq list1 (list obj1 coord1)) (setq ss1list (cons list1 ss1list)) (setq index1 (+ index1 1)) ) (princ "\n pick 2nd group of text") (setq ss2 (ssget ":L" '((0 . "*TEXT")))) (setq ss2l (sslength ss2)) (setq index2 0) (setq ss2list '()) ;make 2nd list (repeat ss2l (setq obj2 (vlax-ename->vla-object (ssname ss2 index2))) (setq coord2 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj2 'InsertionPoint)))) (setq list2 (list obj2 coord2)) (setq ss2list (cons list2 ss2list)) (setq index2 (+ index2 1)) ) (setq pairstack '()) (setq index11 0) (repeat ssl (setq coord11 (cadr (nth index11 ss1list))) (setq index22 0) (setq distlist '()) (repeat ss2l (setq coord22 (cadr (nth index22 ss2list))) (setq dist12 (distance coord11 coord22)) (setq distlist (cons (list (car (nth index22 ss2list)) dist12) distlist)) (setq index22 (+ index22 1)) ) (setq distlist (vl-sort distlist (function (lambda (x1 x2)(< (cadr x1) (cadr x2))) ) )) (setq distmin (car (car distlist))) (setq pairlist (list (car (nth index11 ss1list)) distmin)) (setq pairstack (cons pairlist pairstack)) (setq index11 (+ index11 1)) ) (setq pslen (length pairstack)) (setq psindex 0) (repeat pslen (setq txt1 (car (nth psindex pairstack))) (setq txt2 (cadr (nth psindex pairstack))) (setq puttxt (strcat (vlax-get-property txt1 'TextString) " / " (vlax-get-property txt2 'TextString))) (vlax-put-property txt1 'TextString puttxt) (setq psindex (+ psindex 1)) ) );end of progn );end of if (princ) );end of defun COMMAND : ECT You should check the areas with overlapping or densed text. it makes error.

And for exisiting attributes Found somewhere I don't remeber exactly ;Converts attributes (attr. definitions, tags) to plain texts (defun C:A2T ( / ss ssl i e new grp grplst addg) (if (setq ss (ssget '((0 . "ATTDEF")))) (progn (setq ssl (sslength ss) i 0 ) (setq grplst (list 7 8 10 11 39 40 41 50 51 62 71 72 73)) (while (< i ssl) (setq e (ssname ss i)) (setq ent (entget e)) (setq new '((0 . "TEXT"))) (setq new (append new (list (cons 1 (cdr (assoc 2 ent)))))) (foreach grp grplst (setq addg (assoc grp ent)) (if (/= addg nil) (setq new (append new (list (assoc grp ent)))) ) ) (entmake new) (entdel e) (setq i (1+ i)) ) ) (princ "\nNo attribute Selected") ) (princ) ) ; defun