Jump to content

Leaderboard

Popular Content

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

  1. I updated the code since then. EXAMPLE: (_addtoolpalettepaths '(;; Don't need to set the default path unless you already removed it :) ;; (strcat (getenv "appdata") "\\Autodesk\\C3D 2018\\enu\\Support\\ToolPalette") "I:\\_CAD STANDARDS\\100 - CAD SUPPORT FILES\\200 - SUPPLEMENTARY FILES\\TOOL PALETTE" ) )
    1 point
  2. 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 point
  3. Using nentsel will get what you want (entget (car (nentsel "Pick attribute"))) just look at what is returned.
    1 point
  4. My version of pline from points. Lee;s is faster. ; create pline from a list of points ; By Alan H March 2019 (defun AHpllst ( lst / x) (command "_pline") (while (= (getvar "cmdactive") 1 ) (repeat (setq x (length lst)) (command (nth (setq x (- x 1)) lst)) ) (command "") ) )
    1 point
  5. 1. You don't need to convert the angle to radians if it is always up. The angle will always be (* pi 0.5) radians 2.If you calculate the points for the end of the line in order then store the point in a list. It would be prudent to strip the z coord whilst doing it (setq pt_lst (cons (reverse (cdr (reverse pt))) pt_lst)) ;cdr returns the rest of a list minus the first entry 3. The list (x y) can now be fed into Lee's minimal entmake LWPolyline function (lwpoly pt_lst 0) ; the 0 is for the group code 70 and denotes an open polyline (defun LWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))))
    1 point
  6. The code I have provided does just that.
    1 point
  7. Here is another sorry don't know author. (if (setq plent (entsel "Pick pline")) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))) ) You could also use ssget "F" pt1 pt2 in a loop keep making pt2 a little bit further out till it crosses the pline. If you know roughly the objects your looking at can make the increment as big as possible to reduce guesses. (defun c:getpoly ( / pt1 pt2 ss x) (setq inc 1.0) (setq pt1 ( getpoint "Pick point inside pline")) (setq pt2 (polar pt1 0.0 inc)) (setq x 0) (while (= (setq ss (ssget "f" (list pt1 pt2) (list (cons 0 "lwpolyline")))) nil) (setq pt2 (polar pt2 0.0 inc)) (setq x (+ x 1)) ; just so can adjust inc can see how many guesses ) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss 0))))) (princ) ) I drew pline 20x 20 so inc = 1 works. If the pline has another say parallel then reduce and pick near right side to reduce guess.
    1 point
  8. See also: https://www.theswamp.org/index.php?action=notifyboard;board=2.0 and https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-for-connect-between-attribute-definition-values-electrical/td-p/9336765
    0 points
×
×
  • Create New...