handasa Posted May 8, 2017 Share Posted May 8, 2017 GREETINGS EVERYONE I need a lisp that find and select the nearest bock named "ManHole" to a point .... this point is the insertion point of another selected block say i select a block named "trench" at some point at the drawing ... then the lisp will search its surroundings for a block named "ManHole" and select/highlight the nearest one any help will be appreciated thanks in advance Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 9, 2017 Share Posted May 9, 2017 (edited) Just pick the 1st block get its insertion point, then make a selection set of the other block and repeat through the slection point using distance ins1 ins2 keep the name of the entity which is minimum, with the selection set use a manual window so makes the search faster no need to pick the obvious way out there blocks. Here is an example (defun c:test ( / ent obj ins1 ins2 dist ss olddist) (setq ent (car (entsel "pick 1st block"))) (setq obj (vlax-ename->vla-object ent)) (setq ins1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj)))) (setq blname (vla-get-name (vlax-ename->vla-object (car (entsel "pick 2nd block"))))) (setq ss (ssget (list (cons 0 "Insert")(cons 2 blname)))) (setq oldist 0.0) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (setq ins2 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj)))) (Setq dist (distance ins1 ins2)) (if (< olddist dist) (princ) (progn (setq olddist dist) (setq handel (vla-get-handle obj)) ) ) (alert (strcat "distance is " (rtos olddist 2 2))) ) ) Edited May 9, 2017 by BIGAL Quote Link to comment Share on other sites More sharing options...
Tharwat Posted May 9, 2017 Share Posted May 9, 2017 Aywa ya handasa. Try this routine and let me know. (defun c:Test ( / blk s e ss p i sn en pt d new ) ;; Tharwat - Date: 09.May.2017 ;; (setq blk "ManHole") ;; [ ManHole ] = Regular block (not a Dynamic) ;; (if (and (setq s (car (entsel "\nPick base Block :"))) (eq (cdr (assoc 0 (setq e (entget s)))) "INSERT") (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blk) (cons 410 (getvar 'CTAB))))) (setq p (cdr (assoc 10 e))) ) (repeat (setq i (sslength ss)) (setq sn (ssname ss (setq i (1- i))) en (entget sn) pt (cdr (assoc 10 en)) ) (cond ((not d) (setq d (list (distance p pt) sn))) ((< (setq new (distance p pt)) (car d)) (setq d (list new sn)))) ) ) (if d (sssetfirst nil (ssadd (cadr d)))) (princ) ) Quote Link to comment Share on other sites More sharing options...
handasa Posted May 9, 2017 Author Share Posted May 9, 2017 Just pick the 1st block get its insertion point, then make a selection set of the other block and repeat through the slection point using distance ins1 ins2 keep the name of the entity which is minimum, with the selection set use a manual window so makes the search faster no need to pick the obvious way out there blocks. Here is an example (defun c:test ( / ent obj ins1 ins2 dist ss olddist) (setq ent (car (entsel "pick 1st block"))) (setq obj (vlax-ename->vla-object ent)) (setq ins1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj)))) (setq blname (vla-get-name (vlax-ename->vla-object (car (entsel "pick 2nd block"))))) (setq ss (ssget (list (cons 0 "Insert")(cons 2 blname)))) (setq oldist 0.0) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (setq ins2 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj)))) (Setq dist (distance ins1 ins2)) (if (< olddist dist) (princ) (progn (setq olddist dist) (setq handel (vla-get-handle obj)) ) ) (alert (strcat "distance is " (rtos olddist 2 2))) ) ) it works well after this little modification (defun c:manhole ( / ent obj ins1 ins2 dist ss olddist) (setq ent (car (entsel "pick 1st block"))) (setq obj (vlax-ename->vla-object ent)) (setq ins1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj)))) (setq blname (vla-get-name (vlax-ename->vla-object (car (entsel "pick 2nd block"))))) (setq ss (ssget (list (cons 0 "Insert")(cons 2 blname)))) (setq olddist 10000) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (setq ins2 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj)))) (Setq dist (distance ins1 ins2)) (if (< olddist dist) (princ) (progn (setq olddist dist) (setq handel (vla-get-handle obj)) ;(setq objHandle (vla-get-handle (vlax-ename->vla-object obj))) ) ) (setq extremes (ssadd obj)) (sssetfirst nil extremes) (alert (strcat "distance is " (rtos olddist 2 2))) ) ) as it shows the distance between the base block and other blocks distributed around it but it still doesn't select/highlight the target block with minimum distance Quote Link to comment Share on other sites More sharing options...
handasa Posted May 9, 2017 Author Share Posted May 9, 2017 Aywa ya handasa. Try this routine and let me know. (defun c:Test ( / blk s e ss p i sn en pt d new ) ;; Tharwat - Date: 09.May.2017 ;; (setq blk "ManHole") ;; [ ManHole ] = Regular block (not a Dynamic) ;; (if (and (setq s (car (entsel "\nPick base Block :"))) (eq (cdr (assoc 0 (setq e (entget s)))) "INSERT") (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blk) (cons 410 (getvar 'CTAB))))) (setq p (cdr (assoc 10 e))) ) (repeat (setq i (sslength ss)) (setq sn (ssname ss (setq i (1- i))) en (entget sn) pt (cdr (assoc 10 en)) ) (cond ((not d) (setq d (list (distance p pt) sn))) ((< (setq new (distance p pt)) (car d)) (setq d (list new sn)))) ) ) (if d (sssetfirst nil (ssadd (cadr d)))) (princ) ) worked like a charm ... thanks a lot Quote Link to comment Share on other sites More sharing options...
Tharwat Posted May 9, 2017 Share Posted May 9, 2017 worked like a charm ...thanks a lot You're welcome. Quote Link to comment Share on other sites More sharing options...
handasa Posted May 9, 2017 Author Share Posted May 9, 2017 You're welcome. can you please extend the lisp so that it draw a line between the base block and the selected one .. i modified it a little bit but there is some cases the lisp give me error "unknow command" (defun c:xv ( / blk s e ss i sn en pt d new ft p) ;; Tharwat - Date: 09.May.2017 ;; (setq blk "ManHole") ;; [ ManHole ] = Regular block (not a Dynamic) ;; (if (and (setq s (car (entsel "\nPick base Block :"))) (eq (cdr (assoc 0 (setq e (entget s)))) "INSERT") (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blk) (cons 410 (getvar 'CTAB))))) (setq p (cdr (assoc 10 e))) ) (repeat (setq i (sslength ss)) (setq sn (ssname ss (setq i (1- i))) en (entget sn) pt (cdr (assoc 10 en)) ) (cond ((not d) (setq d (list (distance p pt) sn))) ((< (setq new (distance p pt)) (car d)) (setq d (list new sn) ft pt))) ) ) (if d (sssetfirst nil (ssadd (cadr d)))) (command "pline" p ft "") (princ) ) Quote Link to comment Share on other sites More sharing options...
Tharwat Posted May 9, 2017 Share Posted May 9, 2017 can you please extend the lisp so that it draw a line between the base block and the selected one .. i modified it a little bit but there is some cases the lisp give me error "unknow command" Like this: (if d (progn (sssetfirst nil (ssadd (cadr d))) (command "_.pline" "_non" p "_non" (cdr (assoc 10 (entget (cadr d)))) ""))) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 10, 2017 Share Posted May 10, 2017 I was not sure what you wanted to do so remove Alert line and just replace with (command "LIne" ins1 ins2 "') Quote Link to comment Share on other sites More sharing options...
handasa Posted May 16, 2017 Author Share Posted May 16, 2017 this part in code : (setq blk "ManHole") ;; [ ManHole ] = Regular block (not a Dynamic) ;; what if it's a dynamic block and it's ? thanks in advance Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 17, 2017 Share Posted May 17, 2017 A dynamic block still has a name and a insertion point. Quote Link to comment Share on other sites More sharing options...
MP7 Posted February 19, 2018 Share Posted February 19, 2018 Hello guys, thx good job with this! Tharwat would it be possible to modify the script so I could work with multiple blocks? Using the same block names as the OP to be clear : let's say you have a drawing with a lot of "manhole" blocks, that's what I would need Thx. 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.