LISP TO EXTEND POLYLINE TO NEAREST BLOCK INTERSECTION

LISP TO EXTEND POLYLINE TO NEAREST BLOCK INTERSECTION

joel.bennettFVVY2
Contributor Contributor
3,096 Views
15 Replies
Message 1 of 16

LISP TO EXTEND POLYLINE TO NEAREST BLOCK INTERSECTION

joel.bennettFVVY2
Contributor
Contributor

I could use some help with creating a LISP file. I have drawings where some of the polylines do not intersect with a block, because snap was not used. See screenshot and sample file. I would like a lisp file where I could use select similar to select all the blocks (or enter a block name) and then the routine would extend any polylines that have a fuzz factor of 1 or less to the nearest block intersection. Some of my drawings have 100s of these lines so using the extend command manually is tedious. 

 

GAPS.PNG

0 Likes
Accepted solutions (1)
3,097 Views
15 Replies
Replies (15)
Message 2 of 16

Sea-Haven
Mentor
Mentor

For me not the fix but rather do correct when drawing, do you have a lisp to draw the lines ? If so should force snap mid of arc or say a end. Both ends of lines are wrong and are random ends. Maybe set osmode to 3. Sometimes taking a step back so no problems to fix. 

 

The purple lines are all over the place but  did not check the blocks appear to be evenly spaced. If you did some form of single line, 90, zig zag as options and draw them correct, a quick look could do ssget "F" left side, ssget "F" right side option "Z" all done. Needs some thought maybe beer money. If the block is always horizontal then bounding box will provide a method.

 

PS your Lan1 goes to Lan2 is that correct ?

 

A quicky manual method draw l line from mid arc left side towards right

do same right side towards left

use array of the 2 lines as blocks have a spacing for array

draw a vert line towards right side.

array line to left spacing

fillet all 3 combos of lines

result is correct 

me do with lisp.

 

Lisp line option draws 4 lines.

SeaHaven_1-1652163965205.png

 

Just a side note if your dwg was sent to me by one of my former team they would be told to slow down and do it right the 1st time, they would be asked to fix before approving. 

 

0 Likes
Message 3 of 16

Kent1Cooper
Consultant
Consultant

Would it matter if the horizontal "legs" of the paths ended up not quite exactly horizontal?  I can picture a method that would, rather than EXTENDing, take each end to the nearest MIDpoint-Osnap location, which would be at the middle of the arc end of a Block.  But it would make at least some of the "legs" not quite orthogonal.  There's also the question of the yellow ones that are a single segment, where the Blocks at their ends are not at the same Y coordinate level.  Should they be made diagonal as in @Sea-Haven 's exaggerated image, or turned into 3-segment Polylines with a vertical segment in the middle, like the purple ones above them?

 

Another approach [which would keep the pieces orthogonal] would be to EXPLODE each path, save its pieces as the Previous selection, MOVE its end "legs" from their ends to those same MIDpoint-Osnap locations on the arc ends of the Blocks, and PEDIT/Multiple/Join them back together with a fuzz factor large enough to overcome the movement.  A tricky part would be figuring out which end segment of a Polyline is which, which resulting Line to Move, and which end of that Line to use for MIDpoint-Osnapping.

 

If the ends would always be within Osnap distance of those MIDpoints, I think either approach could be made to require you to select only the path objects to be adjusted, collectively including paths that may not need to be adjusted.  You would not need to select the Blocks.

Kent Cooper, AIA
0 Likes
Message 4 of 16

ВeekeeCZ
Consultant
Consultant

Just have to say, don't like your poor drawing quality too.

 

Here's my quick contribution. Sysvar setting may differ from version to version, this one works for 2022.

 

The code portion was updated.

0 Likes
Message 5 of 16

joel.bennettFVVY2
Contributor
Contributor

I think the first method should work. For those paths that are not horizontal, I can fix with autoconstrain after running the routine.  For the yellow paths it would be ideal to turn them into 3-segment Polylines with a vertical segment in the middle, like the purple ones above.

 

BeekeeCZ code works but I have to select the polylines in batches. As it is currently written, I can not select all polylines. 
 

 

0 Likes
Message 6 of 16

Sea-Haven
Mentor
Mentor

I had another go at it, the blocks are at a vertical spacing of 2.0 that is great for automation.

Erased all purple Z lines. Much easier to just redo correct.

Drew a short line from mid pt left towards right.

Did a right mid pt line towards left.

Drew a vertical line then used fillet twice so got a correct Z shape with true ortho lines.

Ok now the sequence I just did Offset 2.0, 3 times then fillet 3 times did this like 11 times perfect dwg.

 

So taking that sequence could do a lisp that remembers the original 3 lines and does the offset and fillet as many as required. Will have a think about it.

 

yeah thought about it.

 

 

; zigzag ortho line between points
; By Alanh May 2022

(defun c:zigline ( /  pt1 pt2 ent1 ent2 ent3)

(setvar 'filletrad 0.0)
(setvar 'orthomode 1)
(setvar 'osmode 3)

(setq pt1 (getpoint "\npick 1st mid point on left ") pt2 (getpoint pt1 "\npick 2nd point away from pt1 "))
(command "line" pt1 pt2 "")
(setq ent1 (entlast))
(setq pt1 (getpoint "\npick 1st mid point on right") pt2 (getpoint pt1 "\npick 2nd point away from pt1 "))
(command "line" pt1 pt2 "")
(setq ent3 (entlast))
(setq pt1 (getpoint "\npick 1st vertical point ") pt2 (getpoint pt1 "\npick 2nd vertical point "))
(command "line" pt1 pt2 "")
(setq ent2 (entlast))
(command "fillet" ent1 ent2)
(command "fillet" ent2 ent3)

(setq pt1 (getpoint "\nPick direction for offsets well away "))
(setq howmany (getint "\nHow many to do ? ") spac (getreal "\nEnter spacing "))


(repeat howmany
(command "offset" spac ent1 "" pt1 "")
(setq ent1 (entlast))
(command "offset" spac ent2 "" pt1 "")
(setq ent2 (entlast))
(command "offset" spac ent3 "" pt1 "")
(setq ent3 (entlast))
(command "fillet" ent1 ent2)
(command "fillet" ent2 ent3)
)

(princ)
)

 

0 Likes
Message 7 of 16

Kent1Cooper
Consultant
Consultant

@joel.bennettFVVY2 wrote:

....  For the yellow paths it would be ideal to turn them into 3-segment Polylines with a vertical segment in the middle, like the purple ones above. ....

Here's my take on it, but keeping the horizontal legs of the purple ones horizontal by using the Explode/Move/Rejoin approach except for drawing new Polylines for the single-segment [some of the yellow] originals.  Lightly tested.

 

Call the command, and just grab the entire area of the wire paths [or choose only some if you want] -- it "sees" only Polylines on the Layers of those among your selection, and will fix them all, including the 5-segment one in your drawing.

 

In the yellow initially-single-segment draw-with-jog ones, it puts the vertical jog at the middle of the length of the original.  Greater vertical differences from end to end could result in those overlapping each other at the jogs, but I assume if they were that far off vertically the originals would already have had the jog like most of the purple ones.

 

The constraints on the one purple ]-shaped one are lost in the process.

 

IT'S SPECIFIC TO YOUR SAMPLE DRAWING in its Layer filtering in selection, and in its fuzz factor in the PEDIT/Join operation, so edit those as appropriate.

 

 

(defun C:FWE ; = Fix Wire Ends
  (/ *error* doc svn svv ss n pl pt1 pt2 sspl midX)
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg))
    ); if
    (mapcar 'setvar svn svv); reset System Variables
    (vla-endundomark doc)
    (princ)
  ); defun - *error*
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq ; System Variable saving/resetting without separate variables for each:
    svn '(osmode cmdecho blipmode peditaccept)
    svv (mapcar 'getvar svn)
  ); setq
  (if (setq ss (ssget '((0 . "LWPOLYLINE") (8 . "av-fun-network-dig.audio-phone-isdn,av-fun-audio-mic-spk"))))
    (progn ; then
      (mapcar 'setvar svn '(0 0 0 1))
      (command "_.zoom" "_object" ss ""); [need to be visible for Osnaps]
      (repeat (setq n (sslength ss))
        (setq
          pl (ssname ss (setq n (1- n)))
          pt1 (vlax-curve-getStartPoint pl)
          pt2 (vlax-curve-getEndPoint pl)
        ); setq
        (if (> (vlax-curve-getEndParam pl) 1); not just a single segment
          (progn ; then
            (command "_.explode" pl)
            (setq sspl (ssget "_P"))
            (command
              "_.move" (ssname sspl 0) "" pt1 "_mid" pt1 ; first Line to Block
              "_.move" (ssname sspl (1- (sslength sspl))) "" pt2 "_mid" pt2 ; other end
              "_.pedit" "_multiple" sspl "" "_join" 1 ""
            ); command
          ); progn
          (progn ; else - single segment [assuming horizontal end-of-Block connections]
            (setq midX (car (vlax-curve-getPointAtParam pl 0.5)))
            (command
              "_.pline"
                "_mid" pt1 ; Block arc-end midpoint
                (list midX (cadr (getvar 'lastpoint)))
                (list midX (cadr (osnap pt2 "_mid")))
                "_mid" pt2
                "" ; complete Polyline
              "_.matchprop" pl (entlast) ""
            ); command
            (entdel pl)
          ); progn
        ); if [multiple- vs. single-segment]
      ); repeat
      (mapcar 'setvar svn svv); reset
    ); progn
  ); if [selection]
  (vla-endundomark doc)
  (princ)
); defun

 

 

Kent Cooper, AIA
0 Likes
Message 8 of 16

Sea-Haven
Mentor
Mentor

As you say Kent here is a fix, I just found it faster to erase all and recreate correctly. So in future they are created correctly. Yes need a couple of extra functions like 2pt a line between blocks, draw "U" line work. Also realised should convert after Offset the 3 lines to a pline a bit more code. Add correct layer etc 

 

Need confirmed that junctions are always in a vertical pattern. May be able to draw 1st 3 lines and use a drag over for block count.

 

Up to Joel now.

0 Likes
Message 9 of 16

joel.bennettFVVY2
Contributor
Contributor

This works well. The only desired change would be to skip any lines or polylines that are not connected between connect.wire.number blocks.

0 Likes
Message 10 of 16

Kent1Cooper
Consultant
Consultant

@joel.bennettFVVY2 wrote:

This works well. The only desired change would be to skip any lines or polylines that are not connected between connect.wire.number blocks.


Do you really mean conn.wire.number Blocks?  [That's the Block name in the sample drawing.]

 

I hadn't noticed the little red connection in the sample drawing before.  Should its Layer be added to the filter?  Its problem is that unlike all the other connections, it's in two pieces [one 2-segment and one 1-segment], not a single Polyline from Block to Block.  That would cause trouble with a check such as you're asking for, as well as for my earlier routine, since it is built to find the midpoint of the Arc end of the Block, and there isn't one at one end of each of those two Polylines -- it would "see" the closest midpoint of something else.

 

Do you want a check that there are such Blocks at both ends [assuming correction of the red connection]?  If there is at only one end, should it at least fix that end, and ignore the end with no such Block at it?

 

I'm thinking it would be much easier to check whether Osnap CENter picking at the path end returns anything than it would be to search for a Block and check whether it has the right name.  Would that be a reliable test?

Kent Cooper, AIA
0 Likes
Message 11 of 16

joel.bennettFVVY2
Contributor
Contributor

Responses in bold

 

Do you really mean conn.wire.number Blocks?  [That's the Block name in the sample drawing.]

 

Yes I do mean the conn.wire.number Blocks. I only need to process lines/polylines that are connected to these objects. 

 

I hadn't noticed the little red connection in the sample drawing before.  Should its Layer be added to the filter?  Its problem is that unlike all the other connections, it's in two pieces [one 2-segment and one 1-segment], not a single Polyline from Block to Block.  That would cause trouble with a check such as you're asking for, as well as for my earlier routine, since it is built to find the midpoint of the Arc end of the Block, and there isn't one at one end of each of those two Polylines -- it would "see" the closest midpoint of something else.

 

 

Do you want a check that there are such Blocks at both ends [assuming correction of the red connection]?  If there is at only one end, should it at least fix that end, and ignore the end with no such Block at it?

 

Yes just fix the end connected to the block

 

 

 

I'm thinking it would be much easier to check whether Osnap CENter picking at the path end returns anything than it would be to search for a Block and check whether it has the right name.  Would that be a reliable test?

 

I think that is a reliable method. 

 

0 Likes
Message 12 of 16

trevor.bird.au
Advocate
Advocate

Hi Joel,

 

Please find my solution below which I hope achieves what you require.

ExtendToBlock.gif

 

 

;;  ExtendToBlock.lsp by Trevor Bird
;;
;;  2022-05-14

;;------------------------------------------------------------------------------
(defun c:extendtoblock
  (
    /

    assoc_EndPoint
    assoc_list
    assoc_StartPoint

    col_Blocks
    col_Block_etb
    Coordinates_ocs_list
    Coordinates_ocs_var
    Coordinates_sa
    Coordinates_var
    Coordinates_wcs_list
    Coordinate_ocs_list
    Coordinate_ocs_var
    Coordinate_wcs_list

    dps_idpairs
    dps_inters

    ename_polyline
    EndParam
    EndPoint
    EndPoint_dist
    exploded_list
    exploded_var

    handle_copy
    handle_source

    IDPairs_list
    IDPairs_sa
    inters_list
    inters_point
    inters_sa
    inters_var

    list_blockobjects
    list_blockobjects_temp
    list_points
    list_polylines
    list_polylines_temp
    list_temp

    ObjectID_key
    ObjectID_value
    ObjectName
    objects1_sa
    objects2_list
    objects2_var
    obj_ACAD
    obj_AD
    obj_blockobject
    obj_copy
    obj_idpair_key
    obj_idpair_value
    obj_polyline

    progress_int

    ss_objects
    ss_objects__enames
    ss_objects__objects

    StartParam
    StartPoint
    StartPoint_dist

    vertex_count
    vertex_index
    vertex_Z
  )
  (setq obj_ACAD   (vlax-get-acad-object)
        obj_AD     (vlax-get-property obj_ACAD 'ActiveDocument)
        col_Blocks (vlax-get-property obj_AD 'Blocks)
  );setq

  (setq ss_objects
    (ssget
      (list
        '(-4 . "<OR")
          '(0 . "INSERT")
          '(0 . "*POLYLINE")
        '(-4 . "OR>")

        (if (= (getvar 'CVPORT) 1)
          (cons 410 (getvar 'CTAB))
          '(410 . "Model")
        );if
      );list
    );ssget
  );setq


  (cond
    ( (not ss_objects)
      (princ "\nNo objects selected.")
    );(not ss_objects)

    (ss_objects
      (setq ss_objects__enames  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss_objects)))
            ss_objects__objects (mapcar 'vlax-ename->vla-object ss_objects__enames)

            ;;  Process intersections in a "sandbox" block
            col_Block_etb       (vlax-invoke-method col_Blocks 'Add (vlax-3D-point '(0.0 0.0 0.0)) "*U")

            list_polylines      nil
            list_blockobjects   nil
            dps_idpairs         nil
            progress_int        0
      );setq

      (if acet-ui-progress-init (acet-ui-progress-init "Processing objects..." (length ss_objects__objects)))

      (foreach fe__obj_source ss_objects__objects
        (setq objects1_sa  (vlax-make-safearray vlax-vbObject '(0 . 0)))
        (vlax-safearray-fill objects1_sa (list fe__obj_source))

        (setq objects2_var  (vlax-invoke-method obj_AD 'CopyObjects objects1_sa col_Block_etb 'IDPairs_sa)
              objects2_list (vlax-safearray->list (vlax-variant-value objects2_var))
              obj_copy      (car objects2_list)
              ObjectName    (vlax-get-property obj_copy 'ObjectName)
        );setq

        (cond
          ( (wcmatch ObjectName "AcDb*Polyline")
            (setq list_polylines (append list_polylines (list obj_copy))
                  IDPairs_list   (vlax-safearray->list IDPairs_sa)
            );setq

            ;;  <!--  CopyObjects source/copy mapping
            (foreach fe__obj_IDPair IDPairs_list
              (setq ObjectID_key     (vlax-get-property fe__obj_IDPair 'key)

                    obj_idpair_key   (vlax-invoke-method obj_AD 'ObjectIDToObject ObjectID_key)
                    ObjectID_value   (vlax-get-property fe__obj_IDPair 'Value)

                    obj_idpair_value (vlax-invoke-method obj_AD 'ObjectIDToObject ObjectID_value)

                    handle_source    (vlax-get-property obj_idpair_key 'Handle)
                    handle_copy      (vlax-get-property obj_idpair_value 'Handle)

                                     ;;  copy . source
                    dps_idpairs      (append dps_idpairs (list (cons handle_copy handle_source)))
              );setq

              (vlax-release-object obj_idpair_key)
              (vlax-release-object obj_idpair_value)
            );fe__obj_IDPair
            ;;  CopyObjects source/copy mapping  -->
          );(wcmatch ObjectName "AcDb*Polyline")


          ( (= ObjectName "AcDbBlockReference")
            (setq exploded_var  (vlax-invoke-method obj_copy 'Explode)
                  exploded_list (vlax-safearray->list (vlax-variant-value exploded_var))
            );setq

            (vlax-invoke-method obj_copy 'Delete)
            (vlax-release-object obj_copy)

            (setq list_blockobjects  (append list_blockobjects exploded_list))
          );(= ObjectName "AcDbBlockReference")
        );cond

        (setq progress_int (1+ progress_int))
        (if acet-ui-progress-init  (acet-ui-progress-safe progress_int))
      );fe__obj_source

      (if acet-ui-progress-init (acet-ui-progress-done))
    );ss_objects
  );cond

  (cond
    ( (or
        (not list_polylines)
        (not list_blockobjects)
      );or
      (princ "\nNo objects to process for intersections.")
    );

    (T
      (setq dps_inters          nil
            list_polylines_temp list_polylines
            progress_int        0
      );setq

      (if acet-ui-progress-init (acet-ui-progress-init "Checking for intersections..." (length list_polylines)))

      (while list_polylines_temp
        (setq obj_polyline            (car list_polylines_temp)
              list_polylines_temp     (cdr list_polylines_temp)
              list_blockobjects_temp  list_blockobjects

              handle_copy             (vlax-get-property obj_polyline 'Handle)
              handle_source           (cdr (assoc handle_copy dps_idpairs))

              StartParam              (vlax-curve-getStartParam obj_polyline)
              EndParam                (vlax-curve-getEndParam obj_polyline)

              StartPoint              (vlax-curve-getPointAtParam obj_polyline StartParam)
              EndPoint                (vlax-curve-getPointAtParam obj_polyline EndParam)
        );setq

        (while list_blockobjects_temp
          (setq obj_blockobject        (car list_blockobjects_temp)
                list_blockobjects_temp (cdr list_blockobjects_temp)
                inters_var             (vl-catch-all-apply 'vlax-invoke-method (list obj_polyline 'IntersectWith obj_blockobject acExtendThisEntity))
          );setq

          (cond
            ( (vl-catch-all-error-p inters_var))

            ( (not (setq inters_sa (vlax-variant-value inters_var))))

            ( (not (minusp (vlax-safearray-get-u-bound inters_sa 1)))
              ;;  Intersects.
              (setq inters_list (vlax-safearray->list inters_sa))

              (while inters_list
                (setq inters_point nil)

                (repeat 3
                  (setq inters_point (append inters_point (list (car inters_list)))
                        inters_list  (cdr inters_list)
                  );setq
                );repeat 3

                (setq StartPoint_dist (distance inters_point StartPoint)
                      EndPoint_dist   (distance inters_point EndPoint)
                );setq

                (setq assoc_list (assoc handle_source dps_inters))

                (cond
                  ( (equal StartPoint_dist 0.0 1.e-6))

                  ( (<= StartPoint_dist 1.0)
                    (cond
                      ( (not assoc_list)
                        (setq dps_inters
                          (append dps_inters
                            (list
                              (list
                                handle_source
                                  (cons "StartPoint" inters_point)
                              );list
                            );list
                          );append
                        );setq
                      );(not assoc_list)

                      (assoc_list
                        (setq list_temp  (append assoc_list (list (cons "StartPoint" inters_point)))
                              dps_inters (subst list_temp assoc_list dps_inters)
                        );setq
                      );assoc_list
                    );cond
                  );(<= StartPoint_dist 1.0)
                );cond

                (setq assoc_list (assoc handle_source dps_inters))

                (cond
                  ( (equal EndPoint_dist 0.0 1.e-6))

                  ( (<= EndPoint_dist 1.0)
                    (cond
                      ( (not assoc_list)
                        (setq dps_inters
                          (append dps_inters
                            (list
                              (list
                                handle_source
                                  (cons "EndPoint" inters_point)
                              );list
                            );list
                          );append
                        );setq
                      );(not assoc_list)

                      (assoc_list
                        (setq list_temp  (append assoc_list (list (cons "EndPoint" inters_point)))
                              dps_inters (subst list_temp assoc_list dps_inters)
                        );setq
                      );assoc_list
                    );cond
                  );(<= EndPoint_dist 1.0)
                );cond
              );while inters_list
              ;;  -->
            )
          );cond
        );while list_blockobjects_temp

        (setq progress_int (1+ progress_int))
        (if acet-ui-progress-init (acet-ui-progress-safe progress_int))
      );while list_polylines_temp

      (if acet-ui-progress-init (acet-ui-progress-done))

      ;; Reconstruct polylines with new start/end points (intersection points)
      (foreach fe__list dps_inters
        (setq handle_source         (car fe__list)
              list_temp             (cdr fe__list)

              ename_polyline        (handent handle_source)
              obj_polyline          (vlax-ename->vla-object ename_polyline)

              ObjectName            (vlax-get-property obj_polyline 'ObjectName)
              Coordinates_ocs_var   (vlax-get-property obj_polyline 'Coordinates)
              Coordinates_ocs_list  (vlax-safearray->list (vlax-variant-value Coordinates_ocs_var))

              Coordinates_wcs_list  nil
        );setq

        (cond
          ( (= ObjectName "AcDbPolyline")
            ;;  Lightweight Polyline
            (setq vertex_count (/ (length Coordinates_ocs_list) 2)
                  vertex_Z     (vlax-get-property obj_polyline 'Elevation)
            );setq
          )

          ( (or
                (= ObjectName "AcDb2dPolyline")
                (= ObjectName "AcDb3dPolyline")
            );or
            ;;  Heavy Polyline
            (setq vertex_count (/ (length Coordinates_ocs_list) 3)
                  vertex_Z     nil
            );setq
          )
        );cond

        (setq vertex_index  0)

        (while (< vertex_index vertex_count)
          (setq Coordinate_ocs_var  (vlax-get-property obj_polyline 'Coordinate vertex_index)
                Coordinate_ocs_list (vlax-safearray->list (vlax-variant-value Coordinate_ocs_var))
                vertex_index        (1+ vertex_index)
          );setq

          (if vertex_Z
            (setq Coordinate_ocs_list (append Coordinate_ocs_list (list vertex_Z)))
          );if vertex_Z

          (setq Coordinate_wcs_list  (trans Coordinate_ocs_list ename_polyline 0)
                Coordinates_wcs_list (append Coordinates_wcs_list (list Coordinate_wcs_list))
          );setq
        );while (< vertex_index vertex_count)

        (setq assoc_StartPoint (assoc "StartPoint" list_temp))

        (if assoc_StartPoint
          (progn
            (setq StartPoint           (cdr assoc_StartPoint)
                  Coordinates_wcs_list (cons StartPoint (cdr Coordinates_wcs_list))
            );setq
          );progn
        );if assoc_StartPoint

        (setq assoc_EndPoint (assoc "EndPoint" list_temp))

        (if assoc_EndPoint
          (progn
            (setq EndPoint             (cdr assoc_EndPoint)
                  Coordinates_wcs_list (reverse (cons EndPoint (cdr (reverse Coordinates_wcs_list))))
            );setq
          );progn
        );if assoc_StartPoint

        (if (= ObjectName "AcDbPolyline")
          (setq list_points (mapcar '(lambda ( _point ) (reverse (cdr (reverse _point)))) Coordinates_wcs_list))
          (setq list_points Coordinates_wcs_list)
        );if

       (setq list_points     (apply 'append list_points)
              Coordinates_sa (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length list_points))))
        );setq

        (vlax-safearray-fill Coordinates_sa list_points)

        (setq Coordinates_var (vlax-make-variant Coordinates_sa (logior vlax-vbArray vlax-vbDouble)))

        (vlax-put-property obj_polyline 'Coordinates Coordinates_var)
        (vlax-invoke-method obj_polyline 'Update)

        (vlax-release-object obj_polyline)
      );fe__list
    );T
  );cond

  (vlax-release-object col_Blocks)
  (vlax-release-object obj_ACAD)
  (vlax-release-object obj_AD)

  (princ)
);c:extendtoblock

;;------------------------------------------------------------------------------
(princ "\nExtendToBlock loaded. Start command with EXTENDTOBLOCK.")
(princ)

 

Regards,

Trevor Bird

0 Likes
Message 13 of 16

CADaSchtroumpf
Advisor
Advisor

Try this! copy-paste the code in command line...

((lambda ( / js_pl n ent dxf_ent lst_pt js_bl pt_ins nb)
  (command "_.zoom" "_all")
  (setq js_pl (ssget "_X" '((0 . "LWPOLYLINE") (67 . 0) (8 . "av-fun-network-dig.audio-phone-isdn,av-fun-audio-mic-spk,av-fun-control"))))
  (cond
    (js_pl
      (repeat (setq n (sslength js_pl))
        (setq
          ent (ssname js_pl (setq n (1- n)))
          dxf_ent (entget ent)
          lst_pt (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent))
        )
        (mapcar
          '(lambda (x)
            (setq
              js_bl (ssget "_C" (mapcar '- x '(0.5 0.5 0.0)) (mapcar '+ x '(0.5 0.5 0.0)) '((0 . "INSERT") (67 . 0) (8 . "avi-equip-*") (2 . "conn.wire.number")))
            )
            (cond
              (js_bl
                (setq pt_ins (cdr (assoc 10 (entget (ssname js_bl 0)))))
                (cond
                  ((equal (list (car pt_ins) (cadr pt_ins)) x 0.5)
                    (entmod (setq dxf_ent (subst (list 10 (car pt_ins) (cadr pt_ins)) (list 10 (car x) (cadr x)) dxf_ent)))
                  )
                  ((equal (list (+ (car pt_ins) 4.006334373594199) (cadr pt_ins)) x 0.5)
                    (entmod (setq dxf_ent (subst (list 10 (+ (car pt_ins) 4.006334373594199) (cadr pt_ins)) (list 10 (car x) (cadr x)) dxf_ent)))
                  )
                )
                (setq
                  nb 0
                  lst_pt (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent))
                )
                (foreach y (mapcar 'cadr lst_pt)
                  (if (and (equal (cadar lst_pt) y 0.5) (not (eq (cdr (assoc 90 dxf_ent)) 2)))
                    (entmod (setq dxf_ent (subst (list 10 (car (nth nb lst_pt)) (cadar lst_pt)) (cons 10 (nth nb lst_pt)) dxf_ent)))
                  )
                  (setq nb (1+ nb))
                )
              )
            )
          )
          (list (car lst_pt) (last lst_pt))
        )
      )
    )
  )
  (prin1)
))
0 Likes
Message 14 of 16

Kent1Cooper
Consultant
Consultant

@joel.bennettFVVY2 wrote:

....

I'm thinking it would be much easier to check whether Osnap CENter picking at the path end returns anything than it would be to search for a Block and check whether it has the right name.  Would that be a reliable test?

 

I think that is a reliable method. 


I have adjustments made to ignore ends without Blocks, and it works except for the need to fine-tune the part above.  If a path has no Block at a given end [I Erased some of the Blocks for testing], but there's another Block associated with the next path and that is close enough, depending on the scale of things and the Zoom level, it can "see" that other Block, which throws off the result.  I just need to set the APERTURE System Variable based on the Zoom level and the size of the Blocks, to prevent that.  Monday....

Kent Cooper, AIA
0 Likes
Message 15 of 16

Kent1Cooper
Consultant
Consultant
Accepted solution

@Kent1Cooper wrote:

.... 

I have adjustments made to ignore ends without Blocks, and it works except for the need to fine-tune the part above.  If a path has no Block at a given end [I Erased some of the Blocks for testing], but there's another Block associated with the next path and that is close enough, ... it can "see" that other Block, which throws off the result.  I just need to set the APERTURE System Variable ....


Well, a couple of days later than I expected, but this seems to accomplish that successfully, in your sample drawing at least:

(defun C:FWE ; = Fix Wire Ends
  (/ *error* doc svn svv ss aper n pl pt1 pt2 blk1 blk2 sspl midX)
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg))
    ); if
    (mapcar 'setvar svn svv); reset System Variables AS APPLICABLE
    (vla-endundomark doc)
    (princ)
  ); defun - *error*
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq ; System Variable saving/resetting without separate variables for each:
    svn '(osmode cmdecho blipmode peditaccept aperture)
    svv (mapcar 'getvar svn)
  ); setq
  (if (setq ss (ssget '((0 . "LWPOLYLINE") (8 . "av-fun*"))))
    (progn ; then
      (command "_.zoom" "_object" ss ""); [need to be visible for Osnaps]
      (setq aper (min (fix (/ (cadr (getvar 'screensize)) (getvar 'viewsize) 2)) 50))
      (if (= aper 0) (setq aper 1)); minimum allowed
      (mapcar 'setvar svn (list 0 0 0 1 aper)); set System Variables
      (repeat (setq n (sslength ss))
        (setq
          pl (ssname ss (setq n (1- n)))
          pt1 (vlax-curve-getStartPoint pl)
          pt2 (vlax-curve-getEndPoint pl)
          blk1 (osnap pt1 "_cen"); there's an arc-end Block at end 1
          blk2 (osnap pt2 "_cen"); and/or at end 2
        ); setq
        (if (or blk1 blk2); Block(s) at either/both end(s)
          (if (> (vlax-curve-getEndParam pl) 1); 'then' for above; not just single segment
            (progn ; then
              (command "_.explode" pl)
              (setq sspl (ssget "_P"))
              (if blk1 (command "_.move" (ssname sspl 0) "" pt1 "_mid" pt1)) ; first Line to Block if present
              (if blk2 (command "_.move" (ssname sspl (1- (sslength sspl))) "" pt2 "_mid" pt2)) ; other end
              (command "_.pedit" "_multiple" sspl "" "_join" 1 "")
            ); progn
            (progn ; else - single segment [assuming horizontal end-of-Block connections]
              (if (and blk1 blk2); Blocks at both ends
                (progn
                  (setq midX (car (vlax-curve-getPointAtParam pl 0.5)))
                  (command
                    "_.pline"
                      "_mid" pt1 ; Block arc-end midpoint
                      (list midX (cadr (getvar 'lastpoint)))
                      (list midX (cadr (osnap pt2 "_mid")))
                      "_mid" pt2
                      "" ; complete Polyline
                    "_.matchprop" pl (entlast) ""
                  ); command
                  (entdel pl)
                ); progn
                (command "_.move" pl "" (if blk1 pt1 pt2) "_mid" (if blk1 pt1 pt2)); else -- one end only
              ); if [both ends or not]
            ); progn
          ); if [multiple- vs. single-segment]
        ); if [any Block(s)] -- no 'else' [leave alone if no Block(s) to fix ends to]
      ); repeat
      (mapcar 'setvar svn svv); reset System Variables
    ); progn
  ); if [selection]
  (vla-endundomark doc)
  (princ)
); defun

It sets the APERTURE System Variable to a box edge of approx. 1 drawing unit [same as for PEDIT/Join later] to avoid Osnapping to the wrong nearby Block when a path end has no Block of its own, but within the allowable 1-to-50 range.  [It can be fine-tuned if needed -- potentially per drawing based on the size in drawing units of different Blocks.]

 

If a multi-segment one is missing the Block at one end, it adjusts only the end where there is a Block.  If a single-segment one is missing the Block at one end, it simply Moves it so that the end with a Block meets the midpoint of the Block's arc end.  If a path has neither Block, it is left alone.  Otherwise it works as before.

Kent Cooper, AIA
0 Likes
Message 16 of 16

joel.bennettFVVY2
Contributor
Contributor

Works perfect, thanks for the amazing work and support!

0 Likes