Lisp draw the center line and the line jointing the 2 points of 2 parallel lines

[TINDANG]

Hi, All
I need help to creat lisp draw the center line and the line jointing the 2 points of 2 parallel lines . 
Thanks !

[BIGAL]

A good task to start learning lisp, look at code examples,

entsel line 1,

get midpoint line1

entsel line2

get midpoint line2

get length of line

get midpoint again of the 2 lines

angle mid1 mid2

use polar to work out the end points of the centre line

get start and end points of the lines

draw line  to the ends of the lines

 

Have a go much better than just waiting for someone to provide an answer. Plenty here to help.

[fuccaro]

@TINDANG

Any progress? Show us what you have until now...

[exceed]

 

; PAIRING - 2023.10.18 exceeds

(defun C:PAIRING (/ acdoc *error* oldecho @DelAllUrl ss ssl index pairingnumber ent 
                  obj each checkout 1len 1deg ss2 ss2l index2 ent2 obj2 each2 
                  checkout2 2len 2deg 1sp 1ep 2sp 2ep flag each2 checkout2 each3 
                  checkout3 pair11 pair12 pair21 pair22 line1 line2 midpt midlinelen 
                  midpt1 midpt2 midline
                 ) 
  (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (defun *error* (msg) 
    (if (/= msg "Function cancelled") 
      (princ (strcat "\nError: " msg))
    )
    (vla-EndUndoMark acdoc)
    (princ)
  )
  (defun dtr (a) (setq x (* pi (/ a 180.0))))
  (defun rtd (a) (setq x (/ (* a 180) pi)))
  (defun @DelAllUrl (/ ss n k en) 
    (setq ss (ssget "_X" '((0 . "LINE"))))
    (setq n (sslength ss))
    (setq k 0)
    (while (<= 1 n) 
      (setq en (ssname ss k))
      (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object en)) (vla-delete x))
      (setq n (- n 1))
      (setq k (+ k 1))
    )
    (princ)
  )
  (vla-startundomark acdoc)
  (@DelAllUrl)

  (if (not (tblsearch "ltype" "Centerx2")) 
    (progn 
      (setq oldecho (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (command "_.-linetype" "_l" "Centerx2" "acadiso.lin" "") ;"zwcadiso.lin" "")
      (setvar 'cmdecho oldecho)
    )
  )

  (princ "\n Select Lines to Pairing : ")
  (if (setq ss (ssget '((0 . "LINE")))) 
    (progn 
      (setq ssl (sslength ss))
      (setq index 0)
      (setq pairingnumber 0)
      (repeat ssl 
        (setq ent (ssname ss index))
        (setq obj (vlax-ename->vla-object ent))
        (if 
          (vlax-for each (vlax-get-property obj 'Hyperlinks) 
            (setq checkout (vla-get-url each))
          )
          (progn)
          (progn 
            (setq 1len (vlax-get-property obj 'length))
            (setq 1deg (vlax-get-property obj 'angle))
            (if (>= 1deg (dtr 180)) (setq 1deg (- 1deg (dtr 180))))
            (setq 1sp (vlax-safearray->list 
                        (vlax-variant-value (vlax-get-property obj 'startpoint))
                      )
            )
            (setq 1ep (vlax-safearray->list 
                        (vlax-variant-value (vlax-get-property obj 'endpoint))
                      )
            )
            (setq ss2 (ssget "_X" '((0 . "LINE"))))
            (setq ss2l (sslength ss2))
            (setq index2 0)
            (setq flag 0)
            (repeat ss2l 
              (setq ent2 (ssname ss2 index2))
              (setq obj2 (vlax-ename->vla-object ent2))
              (if 
                (vlax-for each2 (vlax-get-property obj2 'Hyperlinks) 
                  (setq checkout2 (vla-get-url each2))
                )
                (progn)
                (progn 
                  (if (and (/= ent ent2) (= flag 0)) 
                    (progn 
                      (setq 2len (vlax-get-property obj2 'length))
                      (setq 2deg (vlax-get-property obj2 'angle))
                      (if (>= 2deg (dtr 180)) (setq 2deg (- 2deg (dtr 180))))
                      (if (and (= 1len 2len) (= 1deg 2deg)) 
                        (progn 
                          (setq 2sp (vlax-safearray->list 
                                      (vlax-variant-value 
                                        (vlax-get-property obj2 'startpoint)
                                      )
                                    )
                          )
                          (setq 2ep (vlax-safearray->list 
                                      (vlax-variant-value 
                                        (vlax-get-property obj2 'endpoint)
                                      )
                                    )
                          )
                          (setq pair11 (distance 1sp 2sp))
                          (setq pair12 (distance 1ep 2ep))
                          (setq pair21 (distance 1sp 2ep))
                          (setq pair22 (distance 1ep 2sp))
                          ;(princ pair11)
                          (if 
                            (and (= (rtos pair11 2 2) (rtos pair12 2 2)) 
                                 (= (rtos pair21 2 2) (rtos pair22 2 2))
                            )
                            (progn 
                              (if 
                                (vlax-for each3 (vlax-get-property obj 'Hyperlinks) 
                                  (setq checkout3 (vla-get-url each3))
                                )
                                (progn)
                                (progn 
                                  (vla-add (vlax-get-property obj 'Hyperlinks) 
                                           (vl-princ-to-string pairingnumber)
                                  )
                                  (vla-add (vlax-get-property obj2 'Hyperlinks) 
                                           (vl-princ-to-string pairingnumber)
                                  )
                                  (setq pairingnumber (+ pairingnumber 1))
                                  (setq flag 1)
                                  (if (> pair11 pair21) 
                                    (progn 
                                      (setq line1 (entmakex 
                                                    (list (cons 0 "LINE") 
                                                          (cons 62 6)
                                                          (cons 10 1sp)
                                                          (cons 11 2sp)
                                                    )
                                                  )
                                      )
                                      (setq line2 (entmakex 
                                                    (list (cons 0 "LINE") 
                                                          (cons 62 6)
                                                          (cons 10 1ep)
                                                          (cons 11 2ep)
                                                    )
                                                  )
                                      )
                                      (setq midpt (list 
                                                    (/ (+ (car 1sp) (car 2sp)) 2)
                                                    (/ (+ (cadr 1sp) (cadr 2sp)) 2)
                                                    0.0
                                                  )
                                      )
                                    )
                                    (progn 
                                      (setq line1 (entmakex 
                                                    (list (cons 0 "LINE") 
                                                          (cons 62 6)
                                                          (cons 10 1sp)
                                                          (cons 11 2ep)
                                                    )
                                                  )
                                      )
                                      (setq line2 (entmakex 
                                                    (list (cons 0 "LINE") 
                                                          (cons 62 6)
                                                          (cons 10 1ep)
                                                          (cons 11 2sp)
                                                    )
                                                  )
                                      )
                                      (setq midpt (list 
                                                    (/ (+ (car 1sp) (car 2ep)) 2)
                                                    (/ (+ (cadr 1sp) (cadr 2ep)) 2)
                                                    0.0
                                                  )
                                      )
                                    )
                                  )
                                  (setq midlinelen (+ 1len 20))
                                  (setq midpt1 (polar midpt 1deg (/ midlinelen 2)))
                                  (setq midpt2 (polar midpt 
                                                      (+ 1deg pi)
                                                      (/ midlinelen 2)
                                               )
                                  )
                                  (setq midline (entmakex 
                                                  (list (cons 0 "LINE") 
                                                        (cons 6 "Centerx2")
                                                        (cons 62 1)
                                                        (cons 48 0.2)
                                                        (cons 10 midpt1)
                                                        (cons 11 midpt2)
                                                  )
                                                )
                                  )
                                )
                              )
                            )
                            (progn 
                              ; The length and angle are the same, but the positions are misaligned.
                            )
                          )
                        )
                        (progn)
                      )
                    )
                    (progn)
                  )
                )
              )
              (setq index2 (+ index2 1))
            )
          )
        )
        (setq index (+ index 1))
      )
    )
    (progn)
  )
  (@DelAllUrl)
  (vla-endundomark acdoc)
  (princ)
)

 

Draw a ribbon and a center line on a pair of lines with matching length and angle. The offset of the center line is 10, and centerx2 of acadiso.lin is used.

 

Since the selection is made according to the order of the selection set regardless of the distance,

if there are multiple candidates for parallel lines, they may be paired with unwanted ones.

You can create one more selection set and measure the distance.

Edited October 18, 2023 by exceed

[BIGAL]

Good solution Exceed but the idea was to get TINDANG to have a go.