SlalomeVr Posted September 7, 2019 Share Posted September 7, 2019 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 Quote Link to comment Share on other sites More sharing options...
Roy_043 Posted September 8, 2019 Share Posted September 8, 2019 (edited) 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 Quote Link to comment Share on other sites More sharing options...
SlalomeVr Posted September 8, 2019 Author Share Posted September 8, 2019 Thank You Roy Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.