Jump to content

Recommended Posts

Posted

Hi Friends of Cadtutor..!

 

Would be really Helpful if there were LISP which could do the Request as shown below.

 

Highly Appreciate your support..

 

 

Requirments.jpg

Posted

It's a nice challenge if you have to write a solution from scratch.
I understand that each line segment is always separated by the same distance except when it is the beginning of the parallel line.

Based on that premise, the algorithm could be something like this:
-select all the lines to consider
-check what the minimum recurring distance is between the ends of each pair of closest segments and save that value in a variable. In this way, any ambiguous situation can also be resolved
-perform the unions of each pair of close segments that are at the distance saved in our variable, calculating the intersection by extension of each end and updating each line segment to bring it to that point.
-when we find the case of two segment ends that are close but at a distance different from the one saved in our variable, check if it is possible to obtain an intersection by extension: if this is not possible, it means that these are parallel segments and it will be necessary to create a new segment that joins both.

 

 

If no one has any code already written that would be useful to you, when I have some free time I will try to write something for you.

 

Posted (edited)

The join ends is the easy one you just drag a line over the 2 lines near and end, the reason for drag over near and end is to get start and end points as on occassions and end can be a start & end point so would get a bow tie joining starts and ends.

 

Now where did I put it. Yahoo found it.

 


; Join end of 2 multiple lines convert to pline
; By Alan H March  2021


(defun  c:joinends ( / pt1 pt2 start end  swapends)

(defun ah:swapends (pt / temp d1 d2 ent)
(setq ent (entget (ssname (ssget pt)0 )))
(setq lay (cdr (assoc 8 ent)))
(setq end (cdr (assoc 11 ent)))
(setq start (cdr (assoc 10 ent)))
(setq d1 (distance pt end))
(setq d2 (distance pt start))
(if (< d1 d2)
    (progn
       (setq temp end)
       (setq end start)
       (setq start temp)
    )
)
(command "erase" (cdr (assoc -1 ent)) "")
(princ)
)

(setq oldsnap (getvar 'osmode))

(setq pt1 (getpoint "\Pick 1st point "))
(setq pt2 (getpoint pt1 "\Pick 2nd  point "))

(setq lst (list pt1 pt2))
(setq ss (ssget "F" lst (list (cons 0 "*line"))))
(setq lay (cdr (assoc 8 (entget (ssname ss 0)))))

(setq lst2 '())
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (- x 1))))
(setq obj (vlax-ename->vla-object ent))
(setq pt3 (vlax-curve-getclosestpointto obj pt1))
(setq dist (distance pt1 pt3))
(setq lst2 (cons (list dist pt3) lst2))
)
(setq lst2 (vl-sort lst2 '(lambda (x y) (< (car x)(car y)))))

(setq lst '())
(setq x 0)
(setvar 'osmode 0)
(repeat (/ (sslength ss) 2)
(setq lst '())
(setq pt3 (nth 1 (nth x lst2)))
(ah:swapends pt3)

(setq lst (cons (list (car start) (cadr start))lst))
(setq lst (cons (list (car end)(cadr end)) lst))

(setq pt4 (nth 1 (nth (+ x 1) lst2)))
(ah:swapends pt4)

(setq lst (cons (list (car end)(cadr end)) lst))
(setq lst (cons (list (car start) (cadr start))lst))

(setq x (+ x 2))

(entmakex (append (list (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 8 lay)
          (cons 90 (length lst))
          (cons 70 1))
          (mapcar (function (lambda (p) (cons 10 p))) lst)
           )
)

)

(setvar 'osmode oldsnap)

(princ)
)

 

The broken line work google for answer, turn back into single lines. Big hint Kent Cooper Autodesk forums. Needs to be modified maybe contact him 1st.

Edited by BIGAL
Posted

I think Cadsuray wants something that links all the segments automatically without the user having to interact in each case.

Posted (edited)

In any case, it would be a good idea if Cadsuray could attach an example drawing.

Edited by GLAVCVS
Posted (edited)

Do a google you will find join co-linear lines. Look at my hint. Yes could be modified to search all selected line work. Contact Author he is very helpful. Yes I tested code but it was two at a time.

 

Yes need a sample dwg.

Edited by BIGAL
Posted

Sorry For the Delayed Response GLAVCVS and BIGAL.

 

 

On 1/21/2025 at 2:43 PM, GLAVCVS said:

I think Cadsuray wants something that links all the segments automatically without the user having to interact in each case.

That would be wonderful.

 

I've attached a small sample file. but the actual project file would be more than 20 times the part ive uploaded here.

 

TOCADTUTOR.dwg

Posted

Ok 1st thing a few screwy things in the dwg, you have Z values like 1.2345 e-33, so I used Flatten and made all Z=0. Ok no code needed for next step.

 

Pedit M Join J B 550 enter. This gives a result that is approaching what you want. I then did fillet on the missing corners wirh radius =0.0.

 

Ok next problem you can not join the 1000 gaps automatically as that is beam width, I tried pedit and 1050 and got an interesting result. The 1000 gap is causing all sorts of problems re an automated answer.

 

OK is this concrete beams in plan as I have a draw beams program for concrete slab on ground.

Posted

Thanks for the Response BIGAL and  GLAVCVS

the Below Code seemed to work i am ok with this.

 

(defun c:DrawBoundary (/ ss ent pts pline)
  ;; Prompt user to select lines or polylines
  (setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))
  (if ss
    (progn
      ;; Collect all vertices from selected entities
      (setq pts '())
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        (setq pts (append pts (get-vertices ent)))
      )
      ;; Remove duplicate points
      (setq pts (unique pts))
      ;; Sort points to form a boundary
      (setq pts (sort-points-clockwise pts))
      ;; Draw a closed polyline
      (command "_.pline")
      (foreach pt pts
        (command pt)
      )
      (command "close")
      (princ "\nBoundary polyline created.")
    )
    (princ "\nNo lines or polylines selected.")
  )
  (princ)
)

;; Function to get vertices from a LINE or LWPOLYLINE
(defun get-vertices (ent / elst pts)
  (setq elst (entget ent))
  (if (= (cdr (assoc 0 elst)) "LINE")
    (setq pts (list (cdr (assoc 10 elst)) (cdr (assoc 11 elst))))
    (if (= (cdr (assoc 0 elst)) "LWPOLYLINE")
      (progn
        (setq pts '())
        (foreach x elst
          (if (= (car x) 10)
            (setq pts (cons (cdr x) pts))
          )
        )
        (setq pts (reverse pts))
      )
    )
  )
  pts
)

;; Function to remove duplicate points
(defun unique (lst)
  (if lst
    (cons (car lst) (unique (vl-remove-if '(lambda (x) (equal x (car lst) 1e-8)) (cdr lst))))
  )
)

;; Function to sort points clockwise
(defun sort-points-clockwise (pts / centroid)
  (setq centroid (list (/ (apply '+ (mapcar 'car pts)) (length pts))
                      (/ (apply '+ (mapcar 'cadr pts)) (length pts))))
  (vl-sort pts '(lambda (a b) (< (angle centroid a) (angle centroid b))))
)

 

  • Like 1
Posted

That's great
I was looking for a way to relate segments based on collinearity (equations of the line) and the distance between the ends.
But your solution is much easier and more practical.
Also, you have revealed to me a quality of the 'boundary' command that I didn't know about.

  • Like 1
Posted

I will not abandon my line of research, however.
If I come to any interesting conclusions, I will share them.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...