Draw closest lines from block

[SlalomeVr]

Hello 

I'm trying to update this code to draw only closest lines from block, but I'm blocking with the function "LineToCurve " to return the smallest distance and draw only closest lines from point.

Can you help me please, see attached dwg .

Thanks in advance

 

 

(defun C:linetoblk ( / curve curves blk doc pt1 pt2 ss1 vec )

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_List_Divide_3 (lst / ret)
  (repeat (/ (length lst) 3)
    (setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret))
    (setq lst (cdddr lst))
  )
  (reverse ret)
)  

(defun KGA_Sys_ObjectOwner (obj)
  (vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj))
)
  
(defun LineToCurve (sta vec curves / end line ptLst)
  ;PROBLEM I would like modify this function to draw only the shortest line from curves to the block
  (foreach curve curves
  (setq line
    (vla-addline
      (KGA_Sys_ObjectOwner curve)
      (vlax-3d-point sta)
      (vlax-3d-point (mapcar '+ sta vec))
    )
  )
  (if (setq ptLst (KGA_List_Divide_3 (vlax-invoke line 'intersectwith curve acextendthisentity)))
    (progn
      (setq end (car ptLst))
      (foreach pt (cdr ptLst)
        (if (< (distance sta pt) (distance sta end))
          (setq end pt)
        )
      )
      (vla-put-endpoint line (vlax-3d-point end))
      line
    )
    (progn
      (vla-delete line)
      nil
    )
  )
)
  )
  
  
  (if
    (and
      (princ "\nSelect curves ")
      (setq curves (KGA_Conv_Pickset_To_ObjectList (ssget '((0 . "LINE,*POLYLINE")))))
      (princ "\nSelect blocks: ")
      (setq ss1 (KGA_Conv_Pickset_To_ObjectList (ssget '((0 . "INSERT")))))
      (setq pt1 (getpoint "\nFirst point for verticale direction: "))
      (setq pt2 (getpoint pt1 "\nSecond point for verticale direction: "))
    )
    (progn
      (setq vec (trans (mapcar '- pt2 pt1) 1 0 T))
      (foreach blk ss1
    
        (LineToCurve (vlax-get blk 'insertionpoint) vec curves)
      
      )
    ))

  )

dwgfortest.dwg

[Roy_043]

Original topic:

 

Revised code:

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_List_Divide_3 (lst / ret)
  (repeat (/ (length lst) 3)
    (setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret))
    (setq lst (cdddr lst))
  )
  (reverse ret)
)

(defun KGA_Sys_ObjectOwner (obj)
  (vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj))
)

(defun LineToCurve (sta vec curveLst / end line ptLst)
  (setq line
    (vla-addline
      (KGA_Sys_ObjectOwner (car curveLst))
      (vlax-3d-point sta)
      (vlax-3d-point (mapcar '+ sta vec))
    )
  )
  (if
    (setq ptLst
      (KGA_List_Divide_3
        (apply
          'append
          (mapcar
            '(lambda (curve) (vlax-invoke line 'intersectwith curve acextendthisentity))
            curveLst
          )
        )
      )
    )
    (progn
      (setq end (car ptLst))
      (foreach pt (cdr ptLst)
        (if (< (distance sta pt) (distance sta end))
          (setq end pt)
        )
      )
      (vla-put-endpoint line (vlax-3d-point end))
      line
    )
    (progn
      (vla-delete line)
      nil
    )
  )
)

(defun c:LinesToCurves ( / blkLst curveLst doc pt1 pt2 vec)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (princ "\nSelect curves: ")
      (setq curveLst (KGA_Conv_Pickset_To_ObjectList (ssget '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))))
      (princ "\nSelect blocks: ")
      (setq blkLst (KGA_Conv_Pickset_To_ObjectList (ssget '((0 . "INSERT")))))
      (setq pt1 (getpoint "\nFirst point for direction: "))
      (setq pt2 (getpoint pt1 "\nSecond point for direction: "))
    )
    (progn
      (setq vec (trans (mapcar '- pt2 pt1) 1 0 T))
      (foreach blk blkLst
        (LineToCurve (vlax-get blk 'insertionpoint) vec curveLst)
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

Edited September 8, 2019 by Roy_043

[SlalomeVr]

Thank You Roy