Draw vertical XLINEs from picked points to closets point in the Y direction

[3dwannab]

See the image below. It shows the red line that represents a pick point of pt1 and pt2 along the X-axis.

 

I was hoping to then draw a vertical line through the closest vertices of polylines in the Y axis.

 

See the image before for an explanation of how I think it would work. 1-6 are where the XLINES would go through.

 

See also the cad file to show the final result.

 

 

 

is there anything like this out there?

 

 

Example of Finished Command (Xlines In Blue).dwg

[Tsuky]

A try with this which works with your example
For baselines located in the east, west or north, the code must be improved...

(defun find_inter (obj tmp_obj mod / vrt_pt pt lst_pt)
  (setq vrt_pt (vlax-variant-value (vla-IntersectWith obj tmp_obj mod)))
  (if (>= (vlax-safearray-get-u-bound vrt_pt 1) 0)
    (progn
      (setq pt (vlax-safearray->list vrt_pt))
      (if pt
        (if (> (length pt) 3)
          (repeat (/ (length pt) 3)
            (setq lst_pt (cons (list (car pt) (cadr pt) (caddr pt)) lst_pt) pt (cdddr pt))
          )
          (setq lst_pt (cons pt lst_pt))
        )
      )
    )
  )
  (if (and lst_pt (listp lst_pt))
    lst_pt
  )
)
(defun C:3dwannab ( / ss n ent lst_pt ss_base dxf_ent pt_base ang dlt pt_tmp new_ent l_pt nw_lst)
  (princ "\nSelect polylines.")
  (setq ss (ssget '((0 . "LWPOLYLINE") (67 . 0) (8 . "TS_wall"))))
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          ent (ssname ss (setq n (1- n)))
          lst_pt (append (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent))) lst_pt)
        )
      )
      (princ "\nSelect the reference line.")
      (while (not (setq ss_base (ssget "_+.:E:S" '((0 . "LINE"))))))
      (setq
        dxf_ent (entget (ssname ss_base 0))
        pt_base (list (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)))
        ang (- (rem (angle (car pt_base) (cadr pt_base)) pi) (* pi 0.5))
        dlt (distance (car pt_base) (cadr pt_base))
      )
      (foreach pt lst_pt
        (setq pt_tmp (inters (car pt_base) (cadr pt_base) pt (polar pt ang dlt)))
        (cond
          ((and pt_tmp (eq (sslength (ssget "_F" (list pt pt_tmp) '((0 . "LWPOLYLINE") (67 . 0) (8 . "TS_wall")))) 1))
            (repeat (setq n (sslength ss))
              (entmakex (list '(0 . "LINE") '(100 . "AcDbXline") (cons 10 pt) (cons 11 pt_tmp)))
              (setq
                new_ent (entlast)
                ent (ssname ss (setq n (1- n)))
                l_pt (find_inter (vlax-ename->vla-object ent) (vlax-ename->vla-object new_ent) acExtendNone)
              )
              (entdel new_ent)
              (if (eq (length l_pt) 1) (setq nw_lst (cons (car l_pt) nw_lst)))
            )
          )
        )
      )
      (cond
        (nw_lst
          (mapcar
            '(lambda (x)
              (entmakex
                (list
                  (cons 0 "XLINE")
                  (cons 100 "AcDbEntity")
                  (cons 67 0)
                  (cons 8 (getvar "CLAYER"))
                  (cons 62 5)
                  (cons 100 "AcDbXline")
                  (cons 10 x)
                  (cons 11 '(0.0 1.0 0.0))
                )
              )
            )
            nw_lst
          )
        )
      )
    )
  )
  (prin1)
)

 

[Tsuky]

@devitg

I took over the code to be able to make requests (in a loop) from lines located in the East, North and West.
But I changed the type from XLINE to RAY which leaves the reading clearer.

If it can help you...

 

(defun find_inter (obj tmp_obj mod / vrt_pt pt lst_pt)
  (setq vrt_pt (vlax-variant-value (vla-IntersectWith obj tmp_obj mod)))
  (if (>= (vlax-safearray-get-u-bound vrt_pt 1) 0)
    (progn
      (setq pt (vlax-safearray->list vrt_pt))
      (if pt
        (if (> (length pt) 3)
          (repeat (/ (length pt) 3)
            (setq lst_pt (cons (list (car pt) (cadr pt) (caddr pt)) lst_pt) pt (cdddr pt))
          )
          (setq lst_pt (cons pt lst_pt))
        )
      )
    )
  )
  (if (and lst_pt (listp lst_pt))
    lst_pt
  )
)
(defun C:3dwannab ( / ss n ent lst_pt ss_base dxf_ent pt_base dlt pt_tmp ang dxf_11 new_ent l_pt nw_lst)
  (princ "\nSelect polylines.")
  (setq ss (ssget '((0 . "LWPOLYLINE") (67 . 0) (8 . "TS_wall"))))
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          ent (ssname ss (setq n (1- n)))
          lst_pt (append (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent))) lst_pt)
        )
      )
      (princ "\nSelect the reference line.")
      (while (setq ss_base (ssget "_+.:E:S" '((0 . "LINE"))))
        (setq
          dxf_ent (entget (ssname ss_base 0))
          pt_base (list (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)))
          dlt (distance (car pt_base) (cadr pt_base))
        )
        (foreach a (list 0 (* 0.5 pi) pi (* 1.5 pi))
          (setq pt_tmp (inters (car pt_base) (cadr pt_base) (car lst_pt) (polar (car lst_pt) a dlt) T))
          (if pt_tmp (setq ang a pt_tmp nil))
        )
        (cond
          (ang
            (setq
              dxf_11
              (cond
                ((zerop ang) '(11 1.0 0.0 0.0))
                ((eq ang (* 0.5 pi)) '(11 0.0 1.0 0.0))
                ((eq ang pi) '(11 -1.0 0.0 0.0))
                (T '(11 0.0 -1.0 0.0))
              )
            )
            (foreach pt lst_pt
              (setq pt_tmp (inters (car pt_base) (cadr pt_base) pt (polar pt ang dlt)))
              (cond
                ((and pt_tmp (eq (sslength (ssget "_F" (list pt pt_tmp) '((0 . "LWPOLYLINE") (67 . 0) (8 . "TS_wall")))) 1))
                  (repeat (setq n (sslength ss))
                    (entmakex (list '(0 . "LINE") '(100 . "AcDbXline") (cons 10 pt) (cons 11 pt_tmp)))
                    (setq
                      new_ent (entlast)
                      ent (ssname ss (setq n (1- n)))
                      l_pt (find_inter (vlax-ename->vla-object ent) (vlax-ename->vla-object new_ent) acExtendNone)
                    )
                    (entdel new_ent)
                    (if (eq (length l_pt) 1) (setq nw_lst (cons (car l_pt) nw_lst)))
                  )
                )
              )
            )
            (cond
              (nw_lst
                (mapcar
                  '(lambda (x)
                    (entmakex
                      (list
                        (cons 0 "RAY")
                        (cons 100 "AcDbEntity")
                        (cons 67 0)
                        (cons 8 (getvar "CLAYER"))
                        (cons 62 5)
                        (cons 100 "AcDbRay")
                        (cons 10 x)
                        dxf_11
                      )
                    )
                  )
                  nw_lst
                )
              )
            )
            (setq nw_lst nil)
          )
        )
        (princ "\nSelect the reference line or <Enter for exit>.")
      )
    )
  )
  (prin1)
)

 

[3dwannab]

@Tsuky, I can't thank you enough this is just amazing 

 

Something I never thought I wanted until the other day but such a game-changer. The find_inter  is great.

 

 

 

 

 

Edited July 25, 2023 by 3dwannab

[Tsuky]

@3dwannab

Glad you like it

[3dwannab]

Hi @Tsuky, see the attached drawing, the red line is the reference line but it's not working.

Red line is reference line.dwg

[Tsuky]

Hi @3dwannab

It's simply a property story filtered into the selections.
We have the expressions:

'((0. "LWPOLYLINE") (67. 0) (8. "TS_wall"))

in the code.
Which filters the "LWPOLYLINE" objects located in the "Model" space and in the "TS_wall" layer

In your drawing you do not have the "TS_wall" layer, so no selection.
What to do?
Either create the layer in the drawing and change the layer objects...The code will work.
Either modify the filter in the code for your drawing (twice in the code)

'((0. "LWPOLYLINE") (67. 0) (8. "0"))

And more risky (risk of selection on all layers), delete the layer name property.
 

'((0 . "LWPOLYLINE") (67 . 0))

 

[3dwannab]

Thanks @Tsuky, silly me didn't see the other filter. That's what happens when you're in a rush. 

Edited October 12, 2023 by 3dwannab