Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 02/26/2020 in all areas

  1. 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
    1 point
  2. 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) )
    1 point
×
×
  • Create New...