Connecting Blocks with Polyline

Connecting Blocks with Polyline

Anonymous
Not applicable
3,251 Views
11 Replies
Message 1 of 12

Connecting Blocks with Polyline

Anonymous
Not applicable

Hi all,

 

 

I have been trying to modify some code (WA+ from Beekee CZ) from this thread to change functionality a bit, but my basic LISP skills are letting me down.

 

Basically i want to be able to select some blocks and have a joined polyline with arcs connecting the insertion points via closest distance between blocks.

 

This code will insert the arcs as separate items, which is ok, but i cant get it to join afterwards.

 

And i would really like to not have the initial selection polyline required.

 

If anyone could assist that would be greatly appreciated. Thanks!

 

;; Based on Beekee CZ's alteration of Kent Cooper's routine WA
;; http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/connecting-blocks-with-line-or-arc-for-electrical-plans/m-p/5511255#M330024

(vl-load-com)

(defun C:joinlines (/ *error* _SortPtListByDist MidObjectsBoundingBox oCMDECHO oOSMODE doc pt pt1 pt2 ptm ptl ss i high sset nextent startentity current_layer)

  
  
 ;-------
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'CMDECHO oCMDECHO)
    (setvar 'OSMODE oOSMODE)
    (vla-endundomark doc)
    (princ))

;-------
  (defun _SortPtListByDist  (ptList)
  ;; Argument: Point list
  ;; Returns: Point list, sorted by distance from curve
  ;; By BlackBox
  ;; http://www.cadtutor.net/forum/showthread.php?61433-Help-Sort-a-list-point-by-distance
  (mapcar
    '(lambda (x / ptList2)
       (setq ptList2 (append (cdr x) ptList2)))
    (vl-sort
      (mapcar
        '(lambda (x / pt ptlist2)
           (setq ptlist2
                  (append
                    (cons
                      (vlax-curve-getDistAtPoint
			(ssname sspl 0)
			(vlax-curve-getClosestPointTo (ssname sspl 0) x T))                        
                      x)
                    ptlist2)))
        ptList)
      '(lambda (x y)
         (< (car x) (car y))))))
    
;-------
 (defun MidObjectsBoundingBox (en / Bmin Bmax )
  ;; Argument: Entity
  ;; Returns: Point list of centre

  (vla-GetBoundingBox (vlax-ename->vla-object en) 'PtArMin 'PtArMax)
  (setq Bmin (vlax-safearray->list PtArMin)
	Bmax (vlax-safearray->list PtArMax))
  (polar Bmin
	 (angle Bmin Bmax)
	 (/ (distance Bmin Bmax) 2))
 )

  
;---------------------------------------------------------------------------------
;---------------------------------------------------------------------------------

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)

  (setq oCMDECHO (getvar 'CMDECHO))
  (setq oOSMODE	 (getvar 'OSMODE))
  (setvar 'OSMODE 0)

  (setq current_layer (getvar "CLAYER"))
  (setq startentity (entlast))
  
  (if (and (setq ss (ssget '((0 . "INSERT,CIRCLE,*LINE"))))
	   (<= 3 (sslength ss))
	   (= 1 (sslength (setq sspl (ssget "_p" '((0 . "*LINE"))))))
	   (setq i (sslength ss))
	   (while (not (minusp (setq i (1- i))))
	     (if (wcmatch (cdr (assoc 0 (entget (ssname ss i)))) "CIRCLE,INSERT")
	       (setq pt (MidObjectsBoundingBox (ssname ss i))
		     ptl (if ptl
			   (append (list pt) ptl)
			   (list pt)))
	       T))
	   ptl
	   (setq ptl (_SortPtListByDist ptl)
		 i 0))
    (repeat (1- (length ptl))
      (setq pt1 (nth i ptl)
	    pt2 (nth (1+ i) ptl)
	    ptm (polar (polar pt1
			      (angle pt1 pt2)
			      (/ (distance pt1 pt2) 2))
		       (+ (angle pt1 pt2) (* pi 0.5)) 	 ;for OPPOSITE BULGE set 1.5 instead of 0.5
		       (cond (high)
			     (T (setq high (* (distance pt1 pt2) 0.18)))))) ;change 0.18 for MORE BULGE
      (command "_.ARC" pt1 ptm pt2)
      (setq i (1+ i)))
  (princ "\nWrogn selection. Need INSERT, CIRCLE and single *LINE"))

  (setq sset (ssadd))
  (setq nextent (entnext startentity))
  (while (/= nil nextent)
    (setq sset (ssadd nextent sset))
    (setq nextent (entnext nextent))
  )
  
  (command "join" sset)
  (setvar 'CMDECHO oCMDECHO)
  (setvar 'OSMODE oOSMODE)
  (setvar "CLAYER" current_layer)
  (vla-endundomark doc)
  (princ)
 
)

0 Likes
Accepted solutions (1)
3,252 Views
11 Replies
Replies (11)
Message 2 of 12

ВeekeeCZ
Consultant
Consultant

Post some example dwg to see. Anyway, your request to omit the need of guide polyline kind of discourage my solution, since that was essential. 

 

Maybe Kent has some version of automated sorting.

 

0 Likes
Message 3 of 12

Anonymous
Not applicable

Thanks for the reply. Excuse my ignorance but what is the necessity of the polyline? Is it to determine the starting point?

 

I've attached a simple example DWG. Its just a few blocks in a typical situation. Sometimes there are a handful like this and other times there may be 50 or so. This is just an example block but if functions the same way, some circles and lines with the base point in the center. 

 

P.S. I am aware the ordering wont be perfect every time and that's fine. I'm just hoping for it to do the heavy lifting.

0 Likes
Message 4 of 12

devitg
Advisor
Advisor

Please show us , after . it is just a before.

 

0 Likes
Message 5 of 12

Anonymous
Not applicable

Attached is what the ideal outcome would look like with the arced polyline connecting the blocks. 

0 Likes
Message 6 of 12

Kent1Cooper
Consultant
Consultant

@Anonymous wrote:

.... 

This code will insert the arcs as separate items, which is ok, but i cant get it to join afterwards.

 

.... 
....
(command "join" sset) ....


Could that part of it be as simple as completing the selection for the JOIN command?

 

(command "join" sset "")

Kent Cooper, AIA
0 Likes
Message 7 of 12

Kent1Cooper
Consultant
Consultant

@ВeekeeCZ wrote:

.... your request to omit the need of guide polyline kind of discourage my solution, since that was essential. 

Maybe Kent has some version of automated sorting.


I've worked with sorting positionally in rows-and-columns  terms, specifically in BlockSSSort.lsp, >here<.  But I don't recall any kind of sorting by random-direction raw proximity like this.  Not that it couldn't be done -- I'd have to think about how it might be accomplished, but I imagine something similar may have come up before that you can Search for.

Kent Cooper, AIA
0 Likes
Message 8 of 12

Anonymous
Not applicable

@Kent1Cooper wrote:

@Anonymous wrote:

.... 

This code will insert the arcs as separate items, which is ok, but i cant get it to join afterwards.

 

.... 
....
(command "join" sset) ....


Could that part of it be as simple as completing the selection for the JOIN command?

 

(command "join" sset "")



I think that helped complete the join command, but the join didn't work. they are still separate arc entities. I'm sure it has to do with my shoddy sset/entnext counting implementation.

0 Likes
Message 9 of 12

Anonymous
Not applicable

@Kent1Cooper wrote:

@Anonymous wrote:

.... 

This code will insert the arcs as separate items, which is ok, but i cant get it to join afterwards.

 

.... 
....
(command "join" sset) ....


Could that part of it be as simple as completing the selection for the JOIN command?

 

(command "join" sset "")


So it seems that the sset is only picking up the last arc drawn, which is why the join wont work as its only one entity. Do you know how to fix this?

0 Likes
Message 10 of 12

ВeekeeCZ
Consultant
Consultant
Accepted solution

The JOIN command is one of the few that LISP version is different (older) than current AutoCAD version. If that so, you need to add the (initcommandversion) right in front of that command. Not that there could be more than one versions, then may be (inticommandversion 2). But in this case would be this just enough:

 

  (initcommandversion)
  (command "join" sset "")

BTW If you want to get the current lisp version to work, you need this syntax: (command "join" ent ss),

where ent is ename of the first entity, ss is the selection set of all others to join. I guess its easier to add (initcommandversion).

 

 


@Anonymous wrote:

Excuse my ignorance but what is the necessity of the polyline? Is it to determine the starting point?

...

It's a guideline to determine the direction. The routines finds for all the block the closest points on the polyline, then sorts distances of these points from the beginning of the polyline. People usually have an approximate idea of how to connect the blocks, not just the shortest way. 
Message 11 of 12

Anonymous
Not applicable

@ВeekeeCZ wrote:

The JOIN command is one of the few that LISP version is different (older) than current AutoCAD version. If that so, you need to add the (initcommandversion) right in front of that command. Not that there could be more than one versions, then may be (inticommandversion 2). But in this case would be this just enough:

 

  (initcommandversion)
  (command "join" sset "")

BTW If you want to get the current lisp version to work, you need this syntax: (command "join" ent ss),

where ent is ename of the first entity, ss is the selection set of all others to join. I guess its easier to add (initcommandversion).

 

 


@Anonymous wrote:

Excuse my ignorance but what is the necessity of the polyline? Is it to determine the starting point?

...

It's a guideline to determine the direction. The routines finds for all the block the closest points on the polyline, then sorts distances of these points from the beginning of the polyline. People usually have an approximate idea of how to connect the blocks, not just the shortest way. 

Perfect that's where it was going wrong. It is working perfectly now.

 

The polyline requirement makes sense now. ill just live with that for now.

 

Thanks for your help!

0 Likes
Message 12 of 12

Anonymous
Not applicable

Hi,

Could you please upload the finished LISP for download? Thanks!

0 Likes