Eslam mansour Posted February 23, 2020 Share Posted February 23, 2020 Hi everyone, Cadtutor family ^_^ I'm looking for help in lisp for mechanical draftsman, he distribute clamp ( green block in attached dwg ) on poly line ( pipe ), divide poly line in Equal distant, the distant not exceed 2100 mm , the clamp need to be align with poly line . i hope the idea is clear ^_^ i attached dwg file contain pipe and clamp and final design Best regards, CLAMP.dwg Quote Link to comment Share on other sites More sharing options...
dlanorh Posted February 23, 2020 Share Posted February 23, 2020 Try this. You are asked to select the block you wish to insert. From this the lisp knows the block name and layer. You are then asked to select a Line/LWPolyline etc and the blocks are inserted. Since the lisp doesn't know how the blocks are orientated you are asked if you want to rotate the blocks 90 degrees (default option No) selecting Yes will rotate the blocks for the line. You are then looped back and asked to select another line. To exit the loop select a blank area of screen. The blocks are never inserted at 2100 centres unless the line length is exactly divisible by 2100. (defun rh:yn (msg default / tmp) (initget 6 "Yes No") (setq tmp (cond ( (getkword (strcat msg " [Yes/No] < " default " > : "))) (default))) );end_defun (vl-load-com) (defun rh:entsel (msg e_lst / obj ent) (while (not obj) (setq ent (car (entsel msg))) (if (vl-position (cdr (assoc 0 (entget ent))) e_lst) (setq obj (vlax-ename->vla-object ent)) (alert "Selected entity is NOT a Block")) );end_while obj );end_defun (defun C:MBCL ( / *error* sv_lst sv_vals c_doc c_spc b_obj b_name b_sc sel ent e_pt e_len b_dist t_dist i_pt r_ang n_obj b_lst) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred."))) (princ) );_end_*error*_defun (setq sv_lst (list 'dynmode 'dynprompt 'cmdecho 'osmode 'clayer) sv_vals (mapcar 'getvar sv_lst) c_doc (vla-get-activedocument (vlax-get-acad-object)) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) );end_setq (mapcar 'setvar sv_lst '(3 1 0 0)) (setq b_obj (rh:entsel "\nSelect Block Entity : " (list "INSERT")) b_name (if (vlax-property-available-p b_obj 'effectivename) (vlax-get b_obj 'effectivename) (vlax-get b_obj 'name)) lyr (vlax-get b_obj 'layer) b_sc 1.0 );end_setq (setvar 'clayer lyr) (while (setq sel (entsel "\nSelect Line/Polyline/Spline Entity : ")) (setq ent (car sel) b_lst nil) (cond ( (vl-position (cdr (assoc 0 (entget ent))) (list "SPLINE" "POLYLINE" "LWPOLYLINE" "LINE")) (setq e_pt (vlax-curve-getendpoint ent) e_len (vlax-curve-getdistatpoint ent e_pt) t_dist 0.0) (if (equal (rem (/ e_len 2100) 1.0) 0.0 1.0e-4) (setq b_dist 2100) (setq b_dist (/ e_len (1+ (fix (/ e_len 2100)))))) (while (or (< t_dist e_len) (equal t_dist e_len 1.0e-4)) (setq i_pt (vlax-curve-getpointatdist ent t_dist)) (if (not i_pt) (setq i_pt e_pt)) (setq r_ang (angle '(0 0 0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent i_pt))) n_obj (vlax-invoke c_spc 'insertblock i_pt b_name b_sc b_sc b_sc r_ang) b_lst (cons n_obj b_lst) t_dist (+ t_dist b_dist) );end_setq );end_while (if (= (rh:yn "\nRotate Blocks 90?" "No") "Yes") (foreach blk b_lst (vla-put-rotation blk (+ (* pi 0.5) (vla-get-rotation blk))))) ) );end_cond (setq b_lst nil t_dist b_dist );end_setq );end_while (mapcar 'setvar sv_lst sv_vals) (princ) );end_defun 1 Quote Link to comment Share on other sites More sharing options...
Eslam mansour Posted February 24, 2020 Author Share Posted February 24, 2020 13 hours ago, dlanorh said: Try this. You are asked to select the block you wish to insert. From this the lisp knows the block name and layer. You are then asked to select a Line/LWPolyline etc and the blocks are inserted. Since the lisp doesn't know how the blocks are orientated you are asked if you want to rotate the blocks 90 degrees (default option No) selecting Yes will rotate the blocks for the line. You are then looped back and asked to select another line. To exit the loop select a blank area of screen. The blocks are never inserted at 2100 centres unless the line length is exactly divisible by 2100. (defun rh:yn (msg default / tmp) (initget 6 "Yes No") (setq tmp (cond ( (getkword (strcat msg " [Yes/No] < " default " > : "))) (default))) );end_defun (vl-load-com) (defun rh:entsel (msg e_lst / obj ent) (while (not obj) (setq ent (car (entsel msg))) (if (vl-position (cdr (assoc 0 (entget ent))) e_lst) (setq obj (vlax-ename->vla-object ent)) (alert "Selected entity is NOT a Block")) );end_while obj );end_defun (defun C:MBCL ( / *error* sv_lst sv_vals c_doc c_spc b_obj b_name b_sc sel ent e_pt e_len b_dist t_dist i_pt r_ang n_obj b_lst) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred."))) (princ) );_end_*error*_defun (setq sv_lst (list 'dynmode 'dynprompt 'cmdecho 'osmode 'clayer) sv_vals (mapcar 'getvar sv_lst) c_doc (vla-get-activedocument (vlax-get-acad-object)) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) );end_setq (mapcar 'setvar sv_lst '(3 1 0 0)) (setq b_obj (rh:entsel "\nSelect Block Entity : " (list "INSERT")) b_name (if (vlax-property-available-p b_obj 'effectivename) (vlax-get b_obj 'effectivename) (vlax-get b_obj 'name)) lyr (vlax-get b_obj 'layer) b_sc 1.0 );end_setq (setvar 'clayer lyr) (while (setq sel (entsel "\nSelect Line/Polyline/Spline Entity : ")) (setq ent (car sel) b_lst nil) (cond ( (vl-position (cdr (assoc 0 (entget ent))) (list "SPLINE" "POLYLINE" "LWPOLYLINE" "LINE")) (setq e_pt (vlax-curve-getendpoint ent) e_len (vlax-curve-getdistatpoint ent e_pt) t_dist 0.0) (if (equal (rem (/ e_len 2100) 1.0) 0.0 1.0e-4) (setq b_dist 2100) (setq b_dist (/ e_len (1+ (fix (/ e_len 2100)))))) (while (or (< t_dist e_len) (equal t_dist e_len 1.0e-4)) (setq i_pt (vlax-curve-getpointatdist ent t_dist)) (if (not i_pt) (setq i_pt e_pt)) (setq r_ang (angle '(0 0 0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent i_pt))) n_obj (vlax-invoke c_spc 'insertblock i_pt b_name b_sc b_sc b_sc r_ang) b_lst (cons n_obj b_lst) t_dist (+ t_dist b_dist) );end_setq );end_while (if (= (rh:yn "\nRotate Blocks 90?" "No") "Yes") (foreach blk b_lst (vla-put-rotation blk (+ (* pi 0.5) (vla-get-rotation blk))))) ) );end_cond (setq b_lst nil t_dist b_dist );end_setq );end_while (mapcar 'setvar sv_lst sv_vals) (princ) );end_defun that is great work mr. dlanorh ^^ may can suggest some modifications, * first can i select start and end point of line/polyline Instead of choosing the item itself? * the clamp must be not exceed the length 2100 , i told you how draftman design this pipe : 1-Measure the length of the line 2-Dividing the line length by 2100 and knowing the number of blocks used will tell you two examples: a. The length of the line is 8,400, as in the design dwg and it is divided by 2100, the result is 4 we add 1, which is at the beginning of the line, the sum is 5, between each one the other is completely 2100. this is not the ideal case at work. B. The length of the line 9400 when dividing by 2100 is the result after adding that at the beginning of the line the result is 4.47 If only 5 is drawn the distance between each one is 2350 and this is not correct . the solution is to do a divide the line distance does not exceed 2100 then the result is 6 clamp Among them is the distance of 1880 I hope this challenge is clear to you ^_^ =============================================================== Attached to you is another lisp that we used to distribute the nozzle for extinguishing the fire. The room is drawn and the nozzle is selected and it asks for the distance that it does not exceed when dividing. The code distributes the correct according to the distance that was entered automatically. distribution-RF.lsp nozzle2.dwg Quote Link to comment Share on other sites More sharing options...
dlanorh Posted February 24, 2020 Share Posted February 24, 2020 12 hours ago, Eslam mansour said: that is great work mr. dlanorh ^^ may can suggest some modifications, * first can i select start and end point of line/polyline Instead of choosing the item itself? * the clamp must be not exceed the length 2100 , i told you how draftman design this pipe : 1-Measure the length of the line 2-Dividing the line length by 2100 and knowing the number of blocks used will tell you two examples: a. The length of the line is 8,400, as in the design dwg and it is divided by 2100, the result is 4 we add 1, which is at the beginning of the line, the sum is 5, between each one the other is completely 2100. this is not the ideal case at work. B. The length of the line 9400 when dividing by 2100 is the result after adding that at the beginning of the line the result is 4.47 If only 5 is drawn the distance between each one is 2350 and this is not correct . the solution is to do a divide the line distance does not exceed 2100 then the result is 6 clamp Among them is the distance of 1880 I hope this challenge is clear to you ^_^ =============================================================== Attached to you is another lisp that we used to distribute the nozzle for extinguishing the fire. The room is drawn and the nozzle is selected and it asks for the distance that it does not exceed when dividing. The code distributes the correct according to the distance that was entered automatically. distribution-RF.lsp 1.64 kB · 2 downloads nozzle2.dwg 103.34 kB · 2 downloads Why do you want to select the start and end of the line? A line/polyline already has a start and end, and these are stored as properties of the line/polyline entity/object. The distance between clamps will never exceed 2100. The length of the line is obtained using the vlax-curve functions. This is divide by 2100. The decimal part of the result is discarded and 1 is added. The length of the line is then divided by this to obtain the distance between block. As the divisor is greater than the result of dividing the length by 2100, the distance between blocks will never exceed 2100. As a test draw some sample lines and run the lisp on the lines. Quote Link to comment Share on other sites More sharing options...
Eslam mansour Posted February 25, 2020 Author Share Posted February 25, 2020 17 hours ago, dlanorh said: Why do you want to select the start and end of the line? A line/polyline already has a start and end, and these are stored as properties of the line/polyline entity/object. The distance between clamps will never exceed 2100. The length of the line is obtained using the vlax-curve functions. This is divide by 2100. The decimal part of the result is discarded and 1 is added. The length of the line is then divided by this to obtain the distance between block. As the divisor is greater than the result of dividing the length by 2100, the distance between blocks will never exceed 2100. As a test draw some sample lines and run the lisp on the lines. that is great work mr. dlanorh sorry it is work perfect, the confusion me it is clear now ^_^ may can suggest simple modifications , can i insert the 2100 value from command bar , because i want the lisp more general for any different distant value, too different type of clamps. A LOT OF THANKS ^_^ Quote Link to comment Share on other sites More sharing options...
Eslam mansour Posted February 25, 2020 Author Share Posted February 25, 2020 1 hour ago, Eslam mansour said: that is great work mr. dlanorh sorry it is work perfect, the confusion me it is clear now ^_^ may can suggest simple modifications , can i insert the 2100 value from command bar , because i want the lisp more general for any different distant value, too different type of clamps. A LOT OF THANKS ^_^ What is your opinion? ===================================== (defun rh:yn (msg default / tmp) (initget 6 "Yes No") (setq tmp (cond ( (getkword (strcat msg " [Yes/No] < " default " > : "))) (default))) );end_defun (vl-load-com) (defun rh:entsel (msg e_lst / obj ent) (while (not obj) (setq ent (car (entsel msg))) (if (vl-position (cdr (assoc 0 (entget ent))) e_lst) (setq obj (vlax-ename->vla-object ent)) (alert "Selected entity is NOT a Block")) );end_while obj );end_defun (defun C:MBCL ( / *error* sv_lst sv_vals c_doc c_spc b_obj b_name b_sc sel ent e_pt e_len b_dist t_dist i_pt r_ang n_obj b_lst) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred."))) (princ) );_end_*error*_defun (setq sv_lst (list 'dynmode 'dynprompt 'cmdecho 'osmode 'clayer) sv_vals (mapcar 'getvar sv_lst) c_doc (vla-get-activedocument (vlax-get-acad-object)) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) );end_setq (mapcar 'setvar sv_lst '(3 1 0 0)) (setq b_obj (rh:entsel "\nSelect Clamp Block : " (list "INSERT")) b_name (if (vlax-property-available-p b_obj 'effectivename) (vlax-get b_obj 'effectivename) (vlax-get b_obj 'name)) lyr (vlax-get b_obj 'layer) b_sc 1.0 );end_setq ;============================================================= (setq nd (getdist "Please Enter Clamp Distance :")) ;============================================================= (setvar 'clayer lyr) (while (setq sel (entsel "\nSelect Line/Polyline/Spline Entity : ")) (setq ent (car sel) b_lst nil) (cond ( (vl-position (cdr (assoc 0 (entget ent))) (list "SPLINE" "POLYLINE" "LWPOLYLINE" "LINE")) (setq e_pt (vlax-curve-getendpoint ent) e_len (vlax-curve-getdistatpoint ent e_pt) t_dist 0.0) (if (equal (rem (/ e_len ND) 1.0) 0.0 1.0e-4) (setq b_dist ND) (setq b_dist (/ e_len (1+ (fix (/ e_len ND)))))) (while (or (< t_dist e_len) (equal t_dist e_len 1.0e-4)) (setq i_pt (vlax-curve-getpointatdist ent t_dist)) (if (not i_pt) (setq i_pt e_pt)) (setq r_ang (angle '(0 0 0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent i_pt))) n_obj (vlax-invoke c_spc 'insertblock i_pt b_name b_sc b_sc b_sc r_ang) b_lst (cons n_obj b_lst) t_dist (+ t_dist b_dist) );end_setq );end_while (if (= (rh:yn "\nRotate Blocks 90?" "No") "Yes") (foreach blk b_lst (vla-put-rotation blk (+ (* pi 0.5) (vla-get-rotation blk))))) ) );end_cond (setq b_lst nil t_dist b_dist );end_setq );end_while (mapcar 'setvar sv_lst sv_vals) (princ) );end_defun ==================================================== Quote Link to comment Share on other sites More sharing options...
ronjonp Posted February 25, 2020 Share Posted February 25, 2020 (edited) Here's another one for fun based off your example drawing ( for simple blocks ). (defun c:foo (/ a an b d e i l p s) ;; RJP » 2020-02-25 (cond ((and (setq a (cond ((getdist "\nEnter MAX Distance:<2100> ")) (2100.) ) ) (setq c (car (entsel "\nPick a block to use: "))) (setq bn (cdr (assoc 2 (setq c (entget c))))) (setq s (ssget '((0 . "~INSERT")))) ) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (cond ((and (= 'real (type (setq p (vl-catch-all-apply 'vlax-curve-getendparam (list e))))) (> (setq i (fix (/ (setq d (vlax-curve-getdistatparam e p)) a))) 0) ) (setq l (cond ((or (<= (/ d i) a) (equal (/ d i) a 1e-4)) (/ d i)) ((/ d (1+ i))) ) ) (print l) (setq b 0) (while (and (or (<= b d) (equal b d 1e-4)) (setq p (vlax-curve-getpointatdist e b))) (setq an (angle '(0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p)))) (entmakex (append c (list (cons 10 p) (cons 50 (+ (/ pi 2) an))))) (setq b (+ b l)) ) ) ((print "Object not supported...")) ) ) ) ) (princ) ) Edited February 25, 2020 by ronjonp 1 Quote Link to comment Share on other sites More sharing options...
dlanorh Posted February 25, 2020 Share Posted February 25, 2020 (edited) 3 hours ago, Eslam mansour said: that is great work mr. dlanorh sorry it is work perfect, the confusion me it is clear now ^_^ may can suggest simple modifications , can i insert the 2100 value from command bar , because i want the lisp more general for any different distant value, too different type of clamps. A LOT OF THANKS ^_^ A simple modification which you have already solved. I would however use "getreal" in place of "getdist" and put an initget before to make sure the user enters something that won't crash the lisp. My take (defun rh:yn (msg default / tmp) (initget 6 "Yes No") (setq tmp (cond ( (getkword (strcat msg " [Yes/No] < " default " > : "))) (default))) );end_defun (vl-load-com) (defun rh:entsel (msg e_lst / obj ent) (while (not obj) (setq ent (car (entsel msg))) (if (vl-position (cdr (assoc 0 (entget ent))) e_lst) (setq obj (vlax-ename->vla-object ent)) (alert "Selected entity is NOT a Block")) );end_while obj );end_defun (defun C:MBCL ( / *error* sv_lst sv_vals c_doc c_spc m_spc b_obj b_name b_sc sel ent e_pt e_len b_dist t_dist i_pt r_ang n_obj b_lst) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred."))) (princ) );_end_*error*_defun (setq sv_lst (list 'dynmode 'dynprompt 'cmdecho 'osmode 'clayer) sv_vals (mapcar 'getvar sv_lst) c_doc (vla-get-activedocument (vlax-get-acad-object)) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) );end_setq (mapcar 'setvar sv_lst '(3 1 0 0)) (initget 7) (setq m_spc (getreal "\nEnter Maximum Spacing Distance : ")) (setq b_obj (rh:entsel "\nSelect Block Entity : " (list "INSERT")) b_name (if (vlax-property-available-p b_obj 'effectivename) (vlax-get b_obj 'effectivename) (vlax-get b_obj 'name)) lyr (vlax-get b_obj 'layer) b_sc 1.0 );end_setq (setvar 'clayer lyr) (while (setq sel (entsel "\nSelect Line/Polyline/Spline Entity : ")) (setq ent (car sel) b_lst nil) (cond ( (vl-position (cdr (assoc 0 (entget ent))) (list "SPLINE" "POLYLINE" "LWPOLYLINE" "LINE")) (setq e_pt (vlax-curve-getendpoint ent) e_len (vlax-curve-getdistatpoint ent e_pt) t_dist 0.0) (if (equal (rem (/ e_len m_spc) 1.0) 0.0 1.0e-4) (setq b_dist m_spc) (setq b_dist (/ e_len (1+ (fix (/ e_len m_spc)))))) (while (or (< t_dist e_len) (equal t_dist e_len 1.0e-4)) (if (equal t_dist e_len 1.0e-4) (setq i_pt e_pt) (setq i_pt (vlax-curve-getpointatdist ent t_dist))) (setq r_ang (angle '(0 0 0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent i_pt))) n_obj (vlax-invoke c_spc 'insertblock i_pt b_name b_sc b_sc b_sc r_ang) b_lst (cons n_obj b_lst) t_dist (+ t_dist b_dist) );end_setq );end_while (if (= (rh:yn "\nRotate Blocks 90?" "No") "Yes") (foreach blk b_lst (vlax-put blk 'rotation (+ (* pi 0.5) (vlax-get blk 'rotation))))) ) );end_cond );end_while (mapcar 'setvar sv_lst sv_vals) (princ) );end_defun Edited February 25, 2020 by dlanorh 1 Quote Link to comment Share on other sites More sharing options...
Eslam mansour Posted February 26, 2020 Author Share Posted February 26, 2020 17 hours ago, dlanorh said: A simple modification which you have already solved. I would however use "getreal" in place of "getdist" and put an initget before to make sure the user enters something that won't crash the lisp. My take (defun rh:yn (msg default / tmp) (initget 6 "Yes No") (setq tmp (cond ( (getkword (strcat msg " [Yes/No] < " default " > : "))) (default))) );end_defun (vl-load-com) (defun rh:entsel (msg e_lst / obj ent) (while (not obj) (setq ent (car (entsel msg))) (if (vl-position (cdr (assoc 0 (entget ent))) e_lst) (setq obj (vlax-ename->vla-object ent)) (alert "Selected entity is NOT a Block")) );end_while obj );end_defun (defun C:MBCL ( / *error* sv_lst sv_vals c_doc c_spc m_spc b_obj b_name b_sc sel ent e_pt e_len b_dist t_dist i_pt r_ang n_obj b_lst) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred."))) (princ) );_end_*error*_defun (setq sv_lst (list 'dynmode 'dynprompt 'cmdecho 'osmode 'clayer) sv_vals (mapcar 'getvar sv_lst) c_doc (vla-get-activedocument (vlax-get-acad-object)) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) );end_setq (mapcar 'setvar sv_lst '(3 1 0 0)) (initget 7) (setq m_spc (getreal "\nEnter Maximum Spacing Distance : ")) (setq b_obj (rh:entsel "\nSelect Block Entity : " (list "INSERT")) b_name (if (vlax-property-available-p b_obj 'effectivename) (vlax-get b_obj 'effectivename) (vlax-get b_obj 'name)) lyr (vlax-get b_obj 'layer) b_sc 1.0 );end_setq (setvar 'clayer lyr) (while (setq sel (entsel "\nSelect Line/Polyline/Spline Entity : ")) (setq ent (car sel) b_lst nil) (cond ( (vl-position (cdr (assoc 0 (entget ent))) (list "SPLINE" "POLYLINE" "LWPOLYLINE" "LINE")) (setq e_pt (vlax-curve-getendpoint ent) e_len (vlax-curve-getdistatpoint ent e_pt) t_dist 0.0) (if (equal (rem (/ e_len m_spc) 1.0) 0.0 1.0e-4) (setq b_dist m_spc) (setq b_dist (/ e_len (1+ (fix (/ e_len m_spc)))))) (while (or (< t_dist e_len) (equal t_dist e_len 1.0e-4)) (if (equal t_dist e_len 1.0e-4) (setq i_pt e_pt) (setq i_pt (vlax-curve-getpointatdist ent t_dist))) (setq r_ang (angle '(0 0 0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent i_pt))) n_obj (vlax-invoke c_spc 'insertblock i_pt b_name b_sc b_sc b_sc r_ang) b_lst (cons n_obj b_lst) t_dist (+ t_dist b_dist) );end_setq );end_while (if (= (rh:yn "\nRotate Blocks 90?" "No") "Yes") (foreach blk b_lst (vlax-put blk 'rotation (+ (* pi 0.5) (vlax-get blk 'rotation))))) ) );end_cond );end_while (mapcar 'setvar sv_lst sv_vals) (princ) );end_defun I am unable to express my thanks to you ^^ A LOT OF THANKS ^_^ Quote Link to comment Share on other sites More sharing options...
Eslam mansour Posted February 26, 2020 Author Share Posted February 26, 2020 17 hours ago, ronjonp said: Here's another one for fun based off your example drawing ( for simple blocks ). (defun c:foo (/ a an b d e i l p s) ;; RJP » 2020-02-25 (cond ((and (setq a (cond ((getdist "\nEnter MAX Distance:<2100> ")) (2100.) ) ) (setq c (car (entsel "\nPick a block to use: "))) (setq bn (cdr (assoc 2 (setq c (entget c))))) (setq s (ssget '((0 . "~INSERT")))) ) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (cond ((and (= 'real (type (setq p (vl-catch-all-apply 'vlax-curve-getendparam (list e))))) (> (setq i (fix (/ (setq d (vlax-curve-getdistatparam e p)) a))) 0) ) (setq l (cond ((or (<= (/ d i) a) (equal (/ d i) a 1e-4)) (/ d i)) ((/ d (1+ i))) ) ) (print l) (setq b 0) (while (and (or (<= b d) (equal b d 1e-4)) (setq p (vlax-curve-getpointatdist e b))) (setq an (angle '(0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p)))) (entmakex (append c (list (cons 10 p) (cons 50 (+ (/ pi 2) an))))) (setq b (+ b l)) ) ) ((print "Object not supported...")) ) ) ) ) (princ) ) it is Great work mr. ronjonp ^^ a lot of thanks ^_^ Quote Link to comment Share on other sites More sharing options...
Eslam mansour Posted February 26, 2020 Author Share Posted February 26, 2020 (edited) 19 hours ago, ronjonp said: Here's another one for fun based off your example drawing ( for simple blocks ). (defun c:foo (/ a an b d e i l p s) ;; RJP » 2020-02-25 (cond ((and (setq a (cond ((getdist "\nEnter MAX Distance:<2100> ")) (2100.) ) ) (setq c (car (entsel "\nPick a block to use: "))) (setq bn (cdr (assoc 2 (setq c (entget c))))) (setq s (ssget '((0 . "~INSERT")))) ) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (cond ((and (= 'real (type (setq p (vl-catch-all-apply 'vlax-curve-getendparam (list e))))) (> (setq i (fix (/ (setq d (vlax-curve-getdistatparam e p)) a))) 0) ) (setq l (cond ((or (<= (/ d i) a) (equal (/ d i) a 1e-4)) (/ d i)) ((/ d (1+ i))) ) ) (print l) (setq b 0) (while (and (or (<= b d) (equal b d 1e-4)) (setq p (vlax-curve-getpointatdist e b))) (setq an (angle '(0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p)))) (entmakex (append c (list (cons 10 p) (cons 50 (+ (/ pi 2) an))))) (setq b (+ b l)) ) ) ((print "Object not supported...")) ) ) ) ) (princ) ) Hi mr ronjonp how are you today? i need some help in this lisp , i found it after some search on google . this lisp to auto dimension between blocks ( clamp ) , it has sum issue 1. the dimension insert in different coordination far away from blocks. 2. it work on Horizontal and vertical blocks only , not Align dimension for sloping blocks. I appreciate your help ^_^ QDB .LSP Edited February 26, 2020 by Eslam mansour Quote Link to comment Share on other sites More sharing options...
Eslam mansour Posted February 26, 2020 Author Share Posted February 26, 2020 (edited) 18 hours ago, dlanorh said: A simple modification which you have already solved. I would however use "getreal" in place of "getdist" and put an initget before to make sure the user enters something that won't crash the lisp. My take (defun rh:yn (msg default / tmp) (initget 6 "Yes No") (setq tmp (cond ( (getkword (strcat msg " [Yes/No] < " default " > : "))) (default))) );end_defun (vl-load-com) (defun rh:entsel (msg e_lst / obj ent) (while (not obj) (setq ent (car (entsel msg))) (if (vl-position (cdr (assoc 0 (entget ent))) e_lst) (setq obj (vlax-ename->vla-object ent)) (alert "Selected entity is NOT a Block")) );end_while obj );end_defun (defun C:MBCL ( / *error* sv_lst sv_vals c_doc c_spc m_spc b_obj b_name b_sc sel ent e_pt e_len b_dist t_dist i_pt r_ang n_obj b_lst) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred."))) (princ) );_end_*error*_defun (setq sv_lst (list 'dynmode 'dynprompt 'cmdecho 'osmode 'clayer) sv_vals (mapcar 'getvar sv_lst) c_doc (vla-get-activedocument (vlax-get-acad-object)) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) );end_setq (mapcar 'setvar sv_lst '(3 1 0 0)) (initget 7) (setq m_spc (getreal "\nEnter Maximum Spacing Distance : ")) (setq b_obj (rh:entsel "\nSelect Block Entity : " (list "INSERT")) b_name (if (vlax-property-available-p b_obj 'effectivename) (vlax-get b_obj 'effectivename) (vlax-get b_obj 'name)) lyr (vlax-get b_obj 'layer) b_sc 1.0 );end_setq (setvar 'clayer lyr) (while (setq sel (entsel "\nSelect Line/Polyline/Spline Entity : ")) (setq ent (car sel) b_lst nil) (cond ( (vl-position (cdr (assoc 0 (entget ent))) (list "SPLINE" "POLYLINE" "LWPOLYLINE" "LINE")) (setq e_pt (vlax-curve-getendpoint ent) e_len (vlax-curve-getdistatpoint ent e_pt) t_dist 0.0) (if (equal (rem (/ e_len m_spc) 1.0) 0.0 1.0e-4) (setq b_dist m_spc) (setq b_dist (/ e_len (1+ (fix (/ e_len m_spc)))))) (while (or (< t_dist e_len) (equal t_dist e_len 1.0e-4)) (if (equal t_dist e_len 1.0e-4) (setq i_pt e_pt) (setq i_pt (vlax-curve-getpointatdist ent t_dist))) (setq r_ang (angle '(0 0 0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent i_pt))) n_obj (vlax-invoke c_spc 'insertblock i_pt b_name b_sc b_sc b_sc r_ang) b_lst (cons n_obj b_lst) t_dist (+ t_dist b_dist) );end_setq );end_while (if (= (rh:yn "\nRotate Blocks 90?" "No") "Yes") (foreach blk b_lst (vlax-put blk 'rotation (+ (* pi 0.5) (vlax-get blk 'rotation))))) ) );end_cond );end_while (mapcar 'setvar sv_lst sv_vals) (princ) );end_defun Hi mr dlanorh how are you today? i need some help in this lisp , i found it after some search on google . this lisp to auto dimension between blocks ( clamp ) , it has sum issue 1. the dimension insert in different coordination far away from blocks. 2. it work on Horizontal and vertical blocks only , not Align dimension for sloping blocks. I appreciate your help ^_^ QDB .LSP Edited February 26, 2020 by Eslam mansour Quote Link to comment Share on other sites More sharing options...
dlanorh Posted February 26, 2020 Share Posted February 26, 2020 3 hours ago, Eslam mansour said: Hi mr dlanorh how are you today? i need some help in this lisp , i found it after some search on google . this lisp to auto dimension between blocks ( clamp ) , it has sum issue 1. the dimension insert in different coordination far away from blocks. 2. it work on Horizontal and vertical blocks only , not Align dimension for sloping blocks. I appreciate your help ^_^ QDB .LSP 652 B · 1 download Attached are the re-written lisp, and your CLAMP.dwg. I have included the clamp drawing as I used it to test the lisp, and found that it required a DimStyle where the text size etc matched the drawing units. I have called this style CDIMS and you should use it to set up an appropriate DimStyle for use with this lisp. I have also attached an updated version of your distribution-rf.lsp. This should now work with rectangular rooms at any orientation and will position the nozzles centrally in the room. The lisp requires three points to be picked, Bottom Left, Bottom Right and Top Right, to allow the orientation to be calculated. If the rooms are always closed polylines and the nozzle blocks always have their diameter circle, the lisp could be further improved to obtain the nozzle diameter and the three corner automatically from the selection of the nozzle and room polyline. CLAMP.dwg QDB .LSP distribution-RF2.lsp Quote Link to comment Share on other sites More sharing options...
Eslam mansour Posted March 1, 2020 Author Share Posted March 1, 2020 On 2/26/2020 at 4:14 PM, dlanorh said: Attached are the re-written lisp, and your CLAMP.dwg. I have included the clamp drawing as I used it to test the lisp, and found that it required a DimStyle where the text size etc matched the drawing units. I have called this style CDIMS and you should use it to set up an appropriate DimStyle for use with this lisp. I have also attached an updated version of your distribution-rf.lsp. This should now work with rectangular rooms at any orientation and will position the nozzles centrally in the room. The lisp requires three points to be picked, Bottom Left, Bottom Right and Top Right, to allow the orientation to be calculated. If the rooms are always closed polylines and the nozzle blocks always have their diameter circle, the lisp could be further improved to obtain the nozzle diameter and the three corner automatically from the selection of the nozzle and room polyline. CLAMP.dwg 87.68 kB · 1 download QDB .LSP 1.1 kB · 1 download distribution-RF2.lsp 1.68 kB · 1 download I appreciate your help and diligence mr dlanorh thank you very much ^_^ 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.