Lisp to Create Polyline at Middle of Every 2 Selected Lines & Auto Chamfer To Form A Continuous Polyline

[JCYK]

Hi Everyone,

 

Needed some help here. I needed a lisp that can create polyline at the middle of every two parallel lines that I selected. The subsequent polyline created will automatically chamfered with the previous created polyline. I'll try my best to illustrate below:

 

 

When I select line A and line B a polyline will be created in the middle of the two lines. Then I continue to select line C and D another polyline will be created in the middle and it automatically chamfers with the previous created polyline (at distance 0) to form a continuos polyline, and so on. Refer to the 'After' image to understand the end result (generated polyline in green).

 

However there are some issues that need to be tackled in order to achieve what I needed as follow:

 

1) The lines that I need to select (i.e. A to H) can be in the form of normal line, polyline, part of a rectangle and sometimes they are within a block or nested block. Hence I must be still able to select these lines individually instead of end up selecting the whole rectangle or block.

2) When comes to a T-junction situation there needs to be a way for me to choose which side (eg. left or right) the polyline should chamfer to.

3) I need an option/ button to switch to normal polyline command during the process, and also switch back to this lisp command as and when during the process.

 

It would be very very helpful if such lisp can exist. 

 

Any help would be very much appreciated. Many thanks in advance! 

 

[JCYK]

Hi anyone able to help? Thank you very much. 

[Lee Mac]

Post your code and we'll be happy to point you in the right direction

[JCYK]

Hi Lee Mac, thanks for responding. 

 

I do not know how to create lisp code and hope a kind expert would be able to help. 

 

Hope my illustration and explanation is clear enough for everyone, if not pls let me know. It's purpose is actually similar to what M2P function does but the latter is too tedious and time consuming. Hence I'm proposing this method to suit the drawing condition and complete the task faster.  

 

Thanks.

[BIGAL]

I have something but its copyrighted will have a look and see what I can steal out of it. It draws 4 lines at a time.

 

Hmm select 2 lines draw a line, select 2 lines draw a line, fillet, set obj1 = obj2, select 2 lines, oh yeah repeating myself. Thats what you want.

 

; This program draws a line perpendicular from another line. need check was it a pline though, version 2. Need this as well.

 

 

[BIGAL]

I left the code at work just needs a bit more testing but it was working. Will post when back at work.

[Grrr]

Well I was kinda close, and at the same time kinda far from the desired result -

(defun C:test ( / rec->midseg SS i lwL ipL linL )
  
  ; (rec->midseg (car (entsel)))
  (defun rec->midseg ( lwpl / pL )
    (cond 
      ( (eq 'ENAME (type lwpl))
        (setq pL (apply 'append (mapcar '(lambda (x) (if (= 10 (car x)) (list (cdr x)))) (entget lwpl))))
        (setq pL (vl-sort pL '(lambda (a b) (< (car a) (car b)))))
        (setq pL (mapcar '(lambda (x) (nth x pL)) '(0 1 2 3)))
        (cons lwpl
          (apply 
            '(lambda (a b c d)
              (mapcar '(lambda (x) (apply 'mapcar (cons '(lambda (a b) (* 0.5 (+ a b))) (mapcar 'eval x))))
                (if (< (distance a b) (distance b c))
                  '((a b)(c d))
                  '((d a)(b c))
                )
              )
            )
            pL
          )
        )
      )
    )
  )
  
  
  (cond 
    ( (not (setq SS (ssget "_:L-I" '( (0 . "LWPOLYLINE") (-4 . "&=") (70 . 1) (-4 . "<NOT") (-4 . "<>") (42 . 0.0) (-4 . "NOT>") (90 . 4) )))) )
    (
      (progn
        (repeat (setq i (sslength SS))
          (setq lwL (cons (rec->midseg (ssname SS (setq i (1- i)))) lwL))
        )
        (not lwL)
      )
    )
    (t
      (foreach sL lwL
        (if (setq SS (ssget "_CP" (apply 'append (mapcar '(lambda (x) (if (= 10 (car x)) (list (cdr x)))) (entget (car sL))))))
          (repeat (setq i (sslength SS))
            (
              (lambda ( / f p pair1 pair2 tmp )
                (setq f (lambda (p1 p2 c) (if (and p1 p2) (entmakex (mapcar 'cons '(0 10 11 62) (list "LINE" p1 p2 c))))))
                (if 
                  (and 
                    (setq pair2 (cdr (assoc (ssname SS (setq i (1- i))) lwL)))
                    (setq p
                      (apply 'inters 
                        (append
                          (setq pair1 (cdr sL))
                          pair2
                          '(())
                        )
                      )
                    ); setq p
                  ); and
                  (progn 
                    (foreach pair (list pair1 pair2)
                      (vl-some 
                        (function
                          (lambda (pt / SS) 
                            (if 
                              (and
                                (setq SS (ssget "_CP" ((lambda (p fuzz)(mapcar '(lambda (x) (polar p (* x PI) fuzz)) '(0.0 0.5 1.0 1.5 2.0))) pt 1e-1)))
                                (>= (sslength SS) 2)
                              )
                              (progn
                                (setq linL (cons (f p pt 1) linL))
                                (if (setq tmp (last ipL))
                                  (setq linL (cons (f tmp p 1) linL))
                                )
                              )
                            )
                          )
                        )
                        pair
                      )
                    ); foreach
                    (setq ipL (cons p ipL))
                  ); progn
                  
                ); if
              ); lambda
            )
          ); repeat
        ); if
      ); foreach
      (
        (lambda ( L / sL p )
          (setq f (lambda (p1 p2 c) (if (and p1 p2) (entmakex (mapcar 'cons '(0 10 11 62) (list "LINE" p1 p2 c))))))
          (foreach lf '(car last)
            (mapcar 'set '(sL p) (mapcar lf L))
            (vl-some 
              (function
                (lambda (pt / SS) 
                  (if 
                    (and
                      (setq SS (ssget "_CP" ((lambda (p fuzz)(mapcar '(lambda (x) (polar p (* x PI) fuzz)) '(0.0 0.5 1.0 1.5 2.0))) pt 1e-1)))
                      (= 1 (sslength SS))
                    )
                    (setq linL (cons (f p pt 1) linL))
                  )
                )
              )
              (cdr sL)
            ); lambda
          ); foreach
        ); lambda
        (list lwL (reverse ipL))
      )
      (cond 
        (linL
          (
            (lambda ( / SS v )
              (setq SS (ssadd))
              (foreach x linL (if x (ssadd x SS)))
              (cond 
                ( (> (sslength SS) 1)
                  (setq v (getvar 'filedia))
                  (setvar 'filedia 0)
                  (command "_.-OVERKILL" SS "" "D")
                  (setvar 'peditaccept 1)
                  (command "_.PEDIT" "M" SS "" "J" "" "")
                  (setvar 'filedia v)
                )
              )
              
            )
          )
        ); linL
      ); cond
    ); t
  ); cond
  (princ)
)

The above code relies on a "chained rectangles", with no other overlapping geometry and the polyline's direction is based on the longer side of every rectangle.

And still its very buggy.

Edited December 10, 2018 by Grrr

[BIGAL]

My attempt it has a little quirk that a line may not end the middle, you just keep picking pair of lines that you want a middle line of. need maybe some real DWGS to test on and fix the odd line not in middle. Grr I have taken the tack of not doing it all in one go.

 

; line in middle of two lines
; by Alan H Dec 2018

(defun picklines ( / obj1 obj2)
(setq pt2 (getpoint pt1 "pick 2nd point"))
(setq ss (ssget "f" (list pt1 pt2)))
(setq obj1  (ssname ss 0))
(setq obj2  (ssname ss 1))
(setq istype1 (cdr (assoc 0 (entget obj1))))
(setq istype2 (cdr (assoc 0 (entget obj2))))
(if (and (= istype1 "LINE")(= istype2 "LINE"))
(progn
(setq stpt (vlax-curve-getstartpoint (vlax-ename->vla-object obj1)))
(setq endpt (vlax-curve-getendpoint (vlax-ename->vla-object obj1)))
(setq pt1 (polar stpt (angle stpt endpt) (/   (distance stpt endpt) 2.0)  ))
(setq pt2 (vlax-curve-getClosestPointTo (vlax-ename->vla-object obj2) pt1)) 
(setq dist (/   (distance pt1 pt2) 2.0))
(command "offset" dist obj1 pt2 "")
(setq stpt (vlax-curve-getstartpoint (vlax-ename->vla-object (entlast))))
(setq endpt (vlax-curve-getendpoint (vlax-ename->vla-object (entlast))))
)
(progn (Alert "object is not a line")(exit))
)

)

(defun c:linmid ( / pt1 pt2 ss stpt endpt pt4 pt3 oldsnap)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setvar "filletrad" 0.0)
(setq pt1 (getpoint "pick 1st point"))
(picklines)
(setq pt3 (polar stpt (angle stpt endpt) (/   (distance stpt endpt) 2.0)  ))


(while (setq pt1 (getpoint "pick 1st point Enter to exit"))
(picklines)
(setq pt4 (polar stpt (angle stpt endpt) (/   (distance stpt endpt) 2.0) ))
(command "fillet" pt3  pt4 )
(setq pt3 pt4)
)
(setvar 'osmode oldsnap)
)

(c:linmid)

Edited December 10, 2018 by BIGAL

[JCYK]

Hi BIGAL and Grrr,

 

Thanks much! I'll test it out soon and let you know again! =)

 

 

[marko_ribar]

For what I quickly saw... Grrr, you forgot (setvar 'peditaccept 1) before (command "_.PEDIT" "_M" ss "" "_J" "" "") and I haven't tested it, so maybe there are more things to fix...

[Grrr]

1 hour ago, marko_ribar said:

For what I quickly saw... Grrr, you forgot (setvar 'peditaccept 1) before (command "_.PEDIT" "_M" ss "" "_J" "" "") and I haven't tested it, so maybe there are more things to fix...

 

Thanks for the input, Marko - included (setvar 'peditaccept 1).

 

There are alot of issues in my code - quickly describing the algorithm:

• Foreach selected rectangle in the selection, find out the pair of the shortest segment,

  then for each segment get its mid, so you will result with a list of ((p1a p2a)(p1b p2b)(p1c p2c) ..)

  so each item in that list describes the correct middle line to be drawn

• Then invoke inters function to find out the intersecting point for each pair of points

• For each pair find out at which point the rectangles "touch"  (>= (sslength SS) 2) and create a line (this applies for the inner rectangles, (excluding first and last one))

• Then the 

(
    (lambda ( L / sL p )
	; ...
	)
)

draws the lines at the very first and very last rectangle (where (>= (sslength SS) 2) won't be true) so: (foreach lf '(car last) .. )

• And in the end attempt to convert the lines into a lwpolyline

 

But as you can see the whole algorithm is problematic:

it will fail if the rectangles in the selection are not sorted

it will fail if there are squares and not rectangles

it will fail if a pair of chained rectangles are "parallel" and not "perpendicular"

it will fail if the rectangles don't touch - but rather intersect or theres no intersection at all

 

Maybe a quick fix would be to prompt the user to select the rectangles one by one, and prompt with error if its not possible to create intersection between the last and the previous rectangle.

But that was just a pseudo-code I posted, I assume that it might be possible to do it -

By obtaining the point list of lines and their intersections and implementing the travelling salesman algorithm to draw the final polyline.

(as you probably know I'm not that good/clever to write code like this).

 

[BIGAL]

Grr I did the quick and dirty and have to add the pline bit. I ignored that they would be pline rectangs. If you maybe approach it this way use the ssget with a fence option and drag a continuous line in the order of sequence. Then you would get the two rectang lines crossing points hopefully in order convert to square off to get 1/2 dist then draw a new line. And so on.

 

Lets just throw all that away and cheat. Window the objects copy to one side just outside ext-max etc. Explode everything then use the simple intersect lines but with a fence option (was going to add) make the line fillet and pedit as you go, copy the pline created back to correct co-ordinates erase the other copy stuff, zoom back to original point all done.

 

We really need from JCYK real dwg to test on.

 

[Dani_Nadir]

Hello all,

 

I am really interested in this topic...any ideas?

[BIGAL]

Did you try the code that was posted ?

[Dani_Nadir]

On 1/22/2019 at 5:33 AM, BIGAL said:

Did you try the code that was posted ?

 

Hello,

 

Yes, I tried it and I got an error (translated)--->Error mode chain ssget

[BIGAL]

Mine or Grr code ?

 

Post a dwg to test on.

[Dani_Nadir]

16 hours ago, BIGAL said:

Mine or Grr code ?

 

Post a dwg to test on.

Hello

 

I tried both codes hehe,

 

here a dwg 

1.dwg

[Dani_Nadir]

Hello,

 

Any idea about the issue?

[JCYK]

Hi BIGAL, Grrr and all, hope everyone is well.

 

My sincere apology for my absence. I was rained with submission datelines one after another and forgotten to get back to this one! 

 

@BIGAL I tried your code and I would say it's almost there for straight forward situation! Only sometimes the function is not performing correctly hence I've done extensive trials to find out in what situations causes the problem. Here's what I found:

 

1. When the view is too small (i.e. zoom out too much) when using this lisp the chamfer will not perform correctly. (this is not a big problem if cannot be fixed)

2. The 2 lines that I'm going to select and the 2 lines that I last selected (to create middle line) needs to have min. 50% of it's length visible in the model view. If not the 2 middle lines won't chamfer. (will be great to fix this as sometimes there will be 2 lines close to each other and we'll need to zoom in to select them)

3. When comes to T-junction situation where for example left side is shorter than right side the lisp will by default create middle line at the longer side which is not always what we wanted. (Is there a way for me to choose which side the middle line should be created? For example the middle line will be created base on the side (left or right) I select when selecting the 2 lines.)

 

Other issues and improvements:

4. There will be situations where the layout plan has a thick wall and thin wall side by side. The middle lines created for the thick and thin wall are not able to chamfer as they are parallel to each other. However I need the 2 middle lines to be connected to form a continuous polyline as shown in below screenshot. Can this be done?

 

 

5. Can the lisp allow an option for me to use polyline as and when needed to help create my desired enclosed polyline? Meaning I can always able to choose between 'select 2 lines to create middle line' or 'continue with drawing polyline'. This will provide great flexibility to handle all kinds of situation, including item 6 above.

6. The middle line created is not a polyline. Can you make it a continuous polyline by default and also line with of 10 to make it more visible?

7. There seems to be no option to chamfer the last created middle line to the first one that I created when I've finished creating the enclosed middle lines. 

8. Once I entered the lisp command, it also turned off OSNAP. Can leave the OSNAP on so we don't have to keep turning it back on? Will need it in order to select the lines accurately.

 

I attach herewith a layout plan dwg with middle polyline that I need to achieve for your reference.

 

Do let me know if you need any clarification.

Thank you very much in advance!!

 

PLAN.dwg

[hanhphuc]

1 hour ago, JCYK said:

 

 

I attach herewith a layout plan dwg with middle polyline that I need to achieve for your reference.

 

Do let me know if you need any clarification.

Thank you very much in advance!!

 

PLAN.dwgUnavailable

 

 

hi perhaps follow this -> old thread  

though it does not work as expected, at least you get work load 50% reduced

 

Just as start point a bit tricky to select paired lines as shown