Jump to content
SlalomeVr

Draw closest lines from block

Recommended Posts

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

Share this post


Link to post
Share on other sites
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 by Roy_043

Share this post


Link to post
Share on other sites
SlalomeVr

Thank You Roy

Share this post


Link to post
Share on other sites

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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  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...