Connecting Lines to points on a Block

[randys]

Good Day Everyone,

I am sure this can be done, however, I have no idea how, and could really use some help in accomplishing this one.
What I have is some blocks that have upto 4 snap points on this( defined as circles, so small that one must zomm in very tight to see them).
I then have line or polylines and or LWPolylines that are to be connected to these points on the block.

I have been having to re-attach each of these lines by hand, and it's getting not only old, but seems to me that autolisp would be able to accomplish something of this nature. When you have one drawing that seems to have better then 500 of these types of errors in it, it makes for a L-O-N-G day.

If there were a program that could be given the name of a block file, then be told how many snap points are contained on the block, and then progress through each snap point on the first block, and draw say a circle a certain distance outward from the snap point and test to see if any of these lines are touching it, and if so, then locate the end-point of the line and then have it snap to the center of the circle that it was drawn from. Then proceed to jump to each of the other snap points for that block and do the same, if nothing was found, then to simply move on to the next.

I would think it would need to get the total number of the blocks in the drawing, then begin at the first one and get the number of snap points available (always tiny circles) and begin from there until it has progressed through the entire drawing.

I would think actually hope that the routine could accomplish this task in say 15 or 20 minutes, perhaps even faster, as opposed to the 8 or more hours that it is presently taking.

Any help would be great, I'm not sure even where to begin on this one, and from the way I described it, it almost sounds like it can not be done with lisp, but I am hopeful in any case.

Thanks in advance for your assistance,

Randy

[Ed Jobe]

What you describe is not a bad algorithm, except you don't have to draw a circle for a selection, just use a window. But I would first ask, how are you running into this problem in the first place? Perhaps you should start with a method to accurately draw them right the first time. For example add some points to the block and when drawing your lines, use only the NODE snap to reduce the amount of snap locations.

[randys]

Hi Ed,

You are exactly correct. However, this is the way that we received them, and whomever did this work elected to accomplish it, in a less then ideal way, and failed to even activate the Osnap's.
(honestly, I do not even think they knew they existed) :)

When you mention the word algorithm, I am instantly lost, sorry. I've never written one, nor have any idea where to begin. The books I have do not even touch on the subject. Perhaps I should look to some other sources, cause I'm certainly missing something there.

Thanks for the reply Sir.

Randy

[Ed Jobe]

Algorithm is a mathematical/programming term that means (from Websters) "a procedure for solving a mathematical problem". Think of "recipe". I did a quick search in this forum to see if there was anything related to what you want to do. This type of thing has been discussed before, but it was probably on our old forum. I don't have time at the moment to come up with something, but you could get started with your "algorithm". Take it a task at a time. Start with getting a selection set of all the blocks you need to work on using a ss filter. Then you have to cycle through each block's sub-entities looking for valid snap points. You can make some assumptions here (like looking only for circles), based on the geometry of your blocks (I haven't seen them). Translate each point into WCS so you can assign that point to a line that you will find later, which is in the WCS. Then create a new ss centered around that point and modify the line/s in that point by finding which endpoint is closest and swapping that with the new point. Poly's will be harder since you'll have to first locate the right vertex.

Go ahead and get started and if you run into trouble, just come back with the code you have thus far. Perhaps someone else can jump in, since I don't have a lot of code in lisp anymore. I mostly use vb these days.

[stig.madsen]

Interesting enough to give it a shot at coding. The thingie below should work for lines and lightweight plines. Some things to be said, though:
- It sees all circles within the specified block as 'snap points'. This means that your block can't contain circles without being targets.
- It searches for entities in the vicinity of each circle in the specified block. The distance it searches within is equal to half the minimum distance between circle centers (or thereabout .. the distance check is not fully carried out).
- It only works in WCS
- No undo mechanism as such. No solid error checking.
In other words: just a rough sketch.

Anyway, try it out. Type SNAP2BLK at command line and enter the block name to snap to.


(defun list->variant (lst)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length lst))))
lst
)
)
)

(defun variant->list (pt)
(vlax-safearray->list (vlax-variant-value pt)))

(defun 2Dcoords->list (lst / nlst)
(while lst
(setq nlst (cons (list (car lst) (cadr lst)) nlst)
lst (cddr lst)
)
)
(reverse nlst)
)

(defun moveObjects (ss pt / 2dmovept 2dpt closept coords ent i movept obj param vlapt plst)
(setq i 0
vlapt (vlax-3D-point pt)
)
(repeat (sslength ss)
(setq ent (ssname ss i)
obj (vlax-ename->vla-object ent)
i (1+ i)
)
(setq closept (vlax-curve-getClosestPointTo obj pt)
param (vlax-curve-getParamAtPoint obj closept)
movept (vlax-curve-getPointAtParam obj (fix param))
plst nil
)
(cond
((= (vla-get-objectName obj) "AcDbLine")
(if (equal (variant->list (vla-get-startPoint obj)) movept 1e-4)
(vla-put-startPoint obj vlapt)
(vla-put-EndPoint obj vlapt)
)
)
((= (vla-get-objectName obj) "AcDbPolyline")
(setq 2Dmovept (reverse (cdr (reverse movept)))
2Dpt (reverse (cdr (reverse pt)))
coords (2Dcoords->list (variant->list (vla-get-coordinates obj)))
)
(foreach p coords
(if (equal p 2Dmovept 1e-4)
(setq plst (cons 2Dpt plst))
(setq plst (cons p plst))))
(if (setq plst (list->variant (apply 'append (reverse plst))))
(vla-put-coordinates obj plst))
)
)
)
)

(defun attachem (bname / clst a apt blkdef blkent blkins blklst boxpts entlst insert insins mindist sset subset)
(vl-load-com)
(defun getBox (pt dist)
(list (list (- (car pt) dist) (- (cadr pt) dist) (caddr pt))
(list (+ (car pt) dist) (+ (cadr pt) dist) (caddr pt))
)
)
(cond ((setq sset (ssget "_X" (list '(0 . "INSERT") (cons 2 bname))))
(setq blkdef (tblobjname "BLOCK" bname)
blklst (entget blkdef)
blkins (cdr (assoc 10 blklst))
blkent (cdr (assoc -2 blklst))
a 0
)
(while blkent
(setq entlst (entget blkent)
blkent (entnext blkent)
)
(and (= (cdr (assoc 0 entlst)) "CIRCLE")
(setq clst (cons (mapcar '+ (cdr (assoc 10 entlst)) blkins) clst))
)
)
(setq mindist (/ (apply 'min (mapcar 'distance clst (reverse clst))) 2.0))
(repeat (sslength sset)
(setq insert (ssname sset a)
insins (cdr (assoc 10 (entget insert)))
a (1+ a)
)
(foreach pt clst
(setq apt (mapcar '- insins pt))
(setq boxpts (getBox apt mindist))
(cond ((setq subset (ssget "_C" (car boxpts)(cadr boxpts) '((0 . "~INSERT")))
)
(moveObjects subset apt)
)
)
)
)
)
)
)

(defun C:SNAP2BLK (/ name)
(and (/= (setq name (getstring T "\nEnter block name: ")))
(tblsearch "BLOCK" name)
(attachem name))
(princ)
)

[randys]

Interesting enough to give it a shot at coding. The thingie below should work for lines and lightweight plines. Some things to be said, though:
- It sees all circles within the specified block as 'snap points'. This means that your block can't contain circles without being targets.
- It searches for entities in the vicinity of each circle in the specified block. The distance it searches within is equal to half the minimum distance between circle centers (or thereabout .. the distance check is not fully carried out).
- It only works in WCS
- No undo mechanism as such. No solid error checking.
In other words: just a rough sketch.

Anyway, try it out. Type SNAP2BLK at command line and enter the block name to snap to.


Thank you very much, I will certianly run it. It is a start if nothing else. Truely apprecaite your time and effort. WIll let you know how she does.

Thanks again,

Randy

[randys]

Stig.Madsen,

Just wanted to give you an update on how things went. The program loaded great, no issues at all. It did extend the line to the block, which was great as well. I am not certain it found the very small circle's that are present as snap points, but then I'm not certain it was supposed to either.

If it could grab the end-point of the line it is extending to the block, and snap it to the center of the small circle that is used as the snap point, then it would be perfect.

I am not very familiar with Visual lisp, so I'm unable to modify or follow it close enough too determine exactly where to look in the code to tell it to change the end-point of the line to the center of the small circle closet to it.

It is a great routine though, I do not want to sound as though it is not appreciated, it is greatly. Thank you for taking the time to do what you have.

Best Regards,

Randy

[stig.madsen]

I am not certain it found the very small circle's that are present as snap points, but then I'm not certain it was supposed to either.
If the small circles are part of the block then it should be able to find them. Unless, of course, the circles are in a block nested within another block. Is that the case?


If it could grab the end-point of the line it is extending to the block, and snap it to the center of the small circle that is used as the snap point, then it would be perfect.
That's the entire purpose of the routine and if it fails to do it then it's worthless :) Unless, of course, some layers are locked?

I started a rewrite with a new and hopefully safer method but that too would fail if it's used on nested blocks. So before I post the rewrite, perhaps you could upload the block in question so I could see why it fails?

Thanks for the feedback.

[randys]

Here you are Sir,

These are the primary blocks I am working with that have these tiny circular snap areas, hope this helps.

I am grateful for your assistance, and really apprecaite it, Thank you.

Randy

[stig.madsen]

Ahh, I see posting the blocks helped. Thanks. The circular snap areas are not necessarily circles. It's a mix of donuts and circles. On top of that, some contains circles that should not be considered "snap areas" (I guess). Makes the task a little more complex :)

[kennet.sjoberg]

Hi Stig, just a hint to mislead You ; )

move(stretch) Objects to Closes insertion point
cut away a piece of the object, cond/if Rp_xxx lengthen DE -123

or just drop it...

Happy Computing !

kennet

[stig.madsen]

Kennet, you'll still have to do some serious point calculations.

Randy, as Ed Jobe pointed out in another thread, most of us like to show how to fish rather than serve it ala carte. This just to say that I started to grill the fish because I found the cooking interesting and also have to serve it now. But please keep in mind that it shouldn't keep you from learning how to fish 'cos next time it may not be served :)

It turned out to be quite a task - given the various cases of "snap areas" within the blocks - but the code below should account for most of it. There are some blocks (or at least one, Rp_pwr) which have points too close together for the routine to find surrounding objects and I haven't adjusted the code to work for that case but it should work for the others. Still only in WCS, though, and still only with lines and lwplines.
Copy ALL of the code below - including Bill Kramers excellent matrix functions in the next post (too long to fit one post) - and save as a single lsp file. Command is still SNAP2BLK.


(defun list->variant (lst)
(if (>= (length lst) 2)
(vlax-make-variant (vlax-safearray-fill
(vlax-make-safearray vlax-vbDouble
(cons 0 (1- (length lst))))
lst)
)
)
)

(defun variant->list (pt)
(vlax-safearray->list (vlax-variant-value pt))
)

(defun 2Dcoords->list (lst / nlst)
(while lst
(setq nlst (cons (list (car lst) (cadr lst)) nlst)
lst (cddr lst)
)
)
(reverse nlst)
)

(defun massoc (elist code / hit lst)
(while (setq hit (assoc code elist))
(setq lst (cons (cdr hit) lst)
elist (cdr (member hit elist))
)
)
lst
)

(defun averagePoint (ptlist / ax ay az)
(setq ax (/ (apply '+ (mapcar 'car ptlist)) (length ptlist))
ay (/ (apply '+ (mapcar 'cadr ptlist)) (length ptlist)))
(if (member nil (mapcar 'caddr ptlist))
(setq az 0.0)
(setq az (/ (apply '+ (mapcar 'caddr ptlist)) (length ptlist)))
)
(list ax ay az)
)

;;; Find point on obj closest to pt and return
;;; (distance found_point original_point)
(defun findDist (obj pt / cpt par fpt)
(cond ((setq cpt (vlax-curve-getClosestPointTo obj pt))
(setq par (vlax-curve-getParamAtPoint obj cpt))
(cond ((= (vla-get-objectName obj) "AcDbLine")
(setq fpt
(if (> par (/ (vlax-curve-getEndParam obj) 2.0))
(vlax-curve-getEndPoint obj)
(vlax-curve-getStartPoint obj)
)
)
)
((setq
fpt (vlax-curve-getPointAtParam obj (atof (rtos par 2 0)))
)
)
)
)
)
(if fpt (list (distance pt fpt) pt fpt))
)

;;; Return centers of circle subents in block
(defun getOCSCenters (blk minRad maxRad / ent ins entl clst)
(cond ((= (type blk) 'ENAME)
(setq ent (cdr (assoc -2 (entget blk)))
ins (cdr (assoc 10 (entget blk)))
)
(while ent
(setq entl (entget ent)
ent (entnext ent)
)
(if (<= minRad (cdr (assoc 40 entl)) maxRad)
(cond
((= (cdr (assoc 0 entl)) "CIRCLE")
(setq
clst
(cons (mapcar '+ (cdr (assoc 10 entl)) ins) clst)
)
)
((= (cdr (assoc 0 entl)) "LWPOLYLINE")
(setq clst (cons (averagePoint (massoc entl 10)) clst))
)
)
)
)
(reverse clst)
)
)
)

;;; Change point of object in ss to the closest point in plst
(defun moveEm (ss plst / 3D->2D 2Dmovepts 2Dpt coords i minlst movepts obj vlapt plplst)
(defun 3D->2D (p) (reverse (cdr (reverse p))))
(setq i 0)
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss i))
i (1+ i)
)
;; find which point to attach the ent to
(setq minlst
(mapcar (function (lambda (p) (finddist obj p))) plst)
)
(setq movepts
(cdar
(vl-sort minlst
(function (lambda (a b) (< (car a) (car b))))
)
)
)
(cond ((and (car movepts) (cadr movepts))
(setq vlapt (list->variant (car movepts)))
(cond
((= (vla-get-objectName obj) "AcDbLine")
(if
(equal (vlax-curve-getStartPoint obj)
(cadr movepts)
1e-4
)
(vla-put-startPoint obj vlapt)
(vla-put-EndPoint obj vlapt)
)
)
((= (vla-get-objectName obj) "AcDbPolyline")
(setq 2Dmovepts (mapcar '3D->2D movepts)
2Dpt (car 2Dmovepts)
plplst nil
coords (2Dcoords->list
(variant->list (vla-get-coordinates obj))
)
)
(foreach p coords
(if (equal p (cadr 2Dmovepts) 1e-4)
(setq plplst (cons 2Dpt plplst))
(setq plplst (cons p plplst))
)
)
(if (setq plplst (list->variant
(apply 'append (reverse plplst))
)
)
(vla-put-coordinates obj plplst)
)
)
)
)
)
)
)

(defun attachEm (bname / a blkdef blkent blkins
blklst boxpts cpts icpts insert insins
inslst maxdist sset subset getBox)
(vl-load-com)
(defun getBox (pt dist)
(list (list (- (car pt) dist) (- (cadr pt) dist) (caddr pt))
(list (+ (car pt) dist) (+ (cadr pt) dist) (caddr pt))
)
)
(cond ((setq sset (ssget "_X" (list '(0 . "INSERT") (cons 2 bname))))
(setq blkdef (tblobjname "BLOCK" bname)
blklst (entget blkdef)
blkins (cdr (assoc 10 blklst))
blkent (cdr (assoc -2 blklst))
a 0
)
;; get all circles within blkdef with radius of 0.05
(setq cpts (getOCSCenters blkdef 0.05 0.05))
;; determine that all objects within a distance of 2.0 times
;; the max distance between circle subents shall be treated
;; by this routine
(setq maxdist
(* (apply
'max
(mapcar (function (lambda (p) (distance blkins p)))
cpts
)
)
2.0
)
)
;; for each insert found:
;; find circle subents centerpoints in WCS
;; get lines/plines in the neighborhood
;; and pass lines/plines to be changed
(repeat (sslength sset)
(setq insert (ssname sset a)
inslst (entget insert)
insins (cdr (assoc 10 inslst))
boxpts (getBox insins maxdist)
a (1+ a)
)
(cond ((setq subset (ssget "_C"
(car boxpts)
(cadr boxpts)
'((0 . "LINE,LWPOLYLINE"))
)
)
;; transform blkdef points to WCS points, making use
;; of Bill Kramers matrix functions
(setq icpts
(mapcar
(function (lambda (p) (BlockPnt->WCS inslst p)))
cpts
)
)
(moveEm subset icpts)
)
)
)
)
)
)

(defun C:SNAP2BLK (/ name)
(cond ((/= (getvar "WORLDUCS") 1)
(princ "\nUCS not supported. Please change to WCS")
)
((and (/= (setq name (getstring T "\nEnter block name: ")) ""))
(tblsearch "BLOCK" name)
(attachEm name)
)
)
(princ)
)

[stig.madsen]

Bill Kramer's matrix functions:


;;----------------------------------------------------------------------
;; Matrix Manipulations - Bill Kramer
;; The Wizards Lab Scrolls
;;
;; The functions in this LSP file demonstrate basic matrix manipulations
;; using Visual LISP. They are all utilities and may be integrated into
;; other applications. In most cases error testing was not added to
;; allow the reader to grasp the intent of the functions themselves.
;; Error testing to determine the adequacy of the data is something that
;; should be performed prior to calling these functions.
;;
;; FUNCTION PURPOSE
;; ======== =======
;; MatrixOrder Determine size of rectangular matrix
;; AddMatrix Add matrices of like size
;; MultMatrix Multiply matrices
;; MatrixFlip Row-based to/from Column-based
;; BuildBlockMatrix Construct transformation matrix for block insert
;; BlockPnt->WCS Convert point from block definition to insert location
;;
;;----------------------------------------------------------------------
;; Matrix stored in Row order
;;
;; A1 A2 A3
;; B1 B2 B3
;; C1 C2 C3
;;
;; ( ( A1 A2 A3) ( B1 B2 B3) ( C1 C2 C3) )
;;
;;----------------------------------------------------------------------
;;
;; MatrixOrder - Given a matrix (nested list), returns a list
;; with the number of rows and number columns.
;;
(defun MatrixOrder (AA)
(list
(length AA) ;number of rows
(if (listp (car AA))
(length (car AA)) ;number of columns
1)
))
;;----------------------------------------------------------------------
;;
;; AddMatrix - Add Matrices of same size.
;;
;; C = A + B
;;
(defun AddMatrix (AA BB / aRow bRow)
(if (equal (MatrixOrder AA)
(MatrixORder BB))
(mapcar ;Get each row in AA and BB
'(lambda (aRow bRow) ;and put in aRow and bRow
(mapcar '+ aRow bRow)) ;add the values in the rows
AA
BB)))
;;
;;----------------------------------------------------------------------
;;
;; MultMatrix - Multiply two matrices
;;
(defun MultMatrix (AA BB / aRow bCol)
(if (= (cadr (MatrixOrder AA))
(car (MatrixOrder BB)))
(progn
(setq BB (MatrixFlip BB)) ;Row based to column based
(mapcar ;create list of rows
'(lambda (aRow) ;each row from AA
(mapcar ;create nested list of columns
'(lambda (bCol) ;each column from BB
(apply
'+ ;sum the result of
(mapcar
'* ;multiplying each
aRow ;row member by
bCol)) ;each column member.
)
BB)
)
AA))))
;;----------------------------------------------------------------------
;;
;; MatrixFlip - Changes storage order of matrix
;;
;; Row based to and from Column based conversion (or back)
;;
;; a11 a12 Row based: ((a11 a12) (a21 a22))
;; a21 a22 Col based: ((a11 a21) (a12 a22))
;;
(defun MatrixFlip (AA / N U V)
(setq N 0) ;Current column
(repeat (length (car AA)) ;Repeat for each member
(setq U ;build a list
(cons
(mapcar ;with the elements
'(lambda (V) ;from a member of AA
(nth N V)) ;in the N position
AA)
U)
N (1+ N)) ;Next column
)
(reverse U) ;Return answer
)
;;----------------------------------------------------------------------
;;
;; BuildBlockMatrix - Creates a 4x4 coordinate conversion matrix
;; given the basic block parameters.
;;
(defun BuildBlockMatrix (IP ;block insert point
SX ;X scale
SY ;Y scale
SZ ;Z scale
RT ;Rotation angle (radians)
)
(list ;create 4x4 row-based transformation matrix
(list ;first row
(* SX (cos RT))
(* SY -1.0 (sin RT))
0.0
(car IP))
(list ;second row
(* SX (sin RT))
(* SY (cos RT))
0.0
(cadr IP))
(list ;third row
0.0
0.0
SZ
(caddr IP))
(list 0.0 0.0 0.0 1.0) ;last row
)
)
;;---------------------------------------------------------------------
;;
;; BlockPnt->WCS - convert point in block definition coordinate system
;; to World coordinate system.
;;
(defun BlockPnt->WCS (EL ; block insert entity list
PT ; point
/
TM ; Transformation matrix
)
(cond ;make sure EL is an entity list
((= (type EL) 'ENAME)
(setq EL (entget EL)) ;entity name to list
)
((= (type EL) 'VLA-OBJECT) ;entity object referece to list
(setq EL (entget (vlax-vla-object->ename EL))))
)
(setq TM (BuildBlockMatrix ;create transformation matrix
(cdr (assoc 10 EL)) ;insert point
(cdr (assoc 41 EL)) ;scale in X
(cdr (assoc 42 EL)) ;scale in Y
(cdr (assoc 43 EL)) ;scale in Z
(cdr (assoc 50 EL))) ;rotation angle in radians
PT (reverse
(cons 1.0 ;add 4th element to point
(reverse PT)))
PT (mapcar 'list PT) ;row based storage
PT (MultMatrix TM PT) ;multiply transformation by point
;result is a 4x1 matrix
PT (reverse ;only interested in first three data items
(cdr (mapcar 'car (reverse PT))))
)
)
;;----------------------------------------------------------------------

[randys]

I agree, and I have written a few programs myself, however nothing as complex. I have learned a lot from the forum. I apprecaite the assistance, without a doubt.

Touching on what you had indicated in the first of the two responses, I do know how to fish, however there are times when the tackle one is fishing with is not up to par shall I say. It would be like fishing for whales with 6 lb. test, know matter how many times you were lucky enough to hook it, the line would always snap, and you have to start over.

Such is the case here, all the gear to fish, however, only 6 lb test in the tackle box. With that said, I'll say Thank you for your assistance, and for the effort and time as well. Adding to this, I'd like to thank you for the proper tackle to fish for the whale, as the guppies were not feeding much :)

Sincerely,

Thank you

Randy

[Coolmo]

Here's a quick question. Wouldn't it be easier to just get into the blocks themselves and fix whatever little problems there are and then make the block more intuitive to what you want it to do? (i.e. set your own circles or even place snap "blocks" within the block so the program will see the insertion point of those blocks and snap to them)

Are these blocks constantly coming to you from other companys changed or are they set up in their final state? I guess what I'm getting at here is that it would be a waste of time to rework the blocks if a whole new set is coming in tomorrow. I'm also having a hard time trying to figure out what you're snapping to and if you're selecting blocks to snap to or just grabbing one and letting the program do the rest. What is your desired procedure? Can you post an image or file containing the final outcome?

[randys]

Here's a quick question. Wouldn't it be easier to just get into the blocks themselves and fix whatever little problems there are and then make the block more intuitive to what you want it to do? (i.e. set your own circles or even place snap "blocks" within the block so the program will see the insertion point of those blocks and snap to them)

Are these blocks constantly coming to you from other companys changed or are they set up in their final state? I guess what I'm getting at here is that it would be a waste of time to rework the blocks if a whole new set is coming in tomorrow. I'm also having a hard time trying to figure out what you're snapping to and if you're selecting blocks to snap to or just grabbing one and letting the program do the rest. What is your desired procedure? Can you post an image or file containing the final outcome?

Hi WIlliam,

These blocks are the finals. I've been told absolutely no altering at all.
So that ruled out modifying to suite.

One the blocks, you'll need to zoom in tight, there (I'll use the RP_PED block as the example), you will notice that at the mid point on each side, there is a circle. The end of the line that I'm trying to grab is near by, say 2x the diameter of the little circle you see on the block (maybe 3x at the most). Now that the line/lwpolyline has been found, it needs to be able to calculate the coordinates of the end-point closet to the little circle. Now to move the end-point of the line it found, to the center point of the small circle on the block.

I've attached a file that is zoomed in tight to show the line entering from the top.
Hope it helps explain it.

Randy