Jack_O'neill Posted January 25, 2009 Posted January 25, 2009 Hey Guys. Do any of you have a lisp or vba that will do the following: Bear with me, this will take some description. Imagine if you will a rectangle that is 2 1/2 inches wide, and 50 inches tall. Now imagine that there are 10 of these in the same horizontal plain, but spaced irregularly (like fence posts). Now imagine a little diamond shaped symbol (rhombus, for those who prefer technical terms) that is 4 inches tall and 2 inches wide. What I need to do is to copy and place these little symbols next to the rectangles. What I imagine this lisp or vba doing is this. I have the rectangles in place already. Once I determine how far from the bottom of the rectangles I need these symbols, I draw a simple line across all of them. I then start this little program, pick the symbol, then pick the line and it places the diamonds on the outsides of the rectangles with the corner of the diamond touching the intersections of the line and the rectangles. In other words if you look at the attachment, I'd start with the first set, and end up with the second. And if it could erase the line too, that would be great, but not necessary. The location of the vertical rectangles will vary horizontally, as will the vertical position of the rhombus. Anybody got anything that will do this? Thanks guys. Quote
Lee Mac Posted January 25, 2009 Posted January 25, 2009 Are the rhombusses/rectangles blocks or polylines? It may be easier if you could post a sample drawing (in 2000 format) of the objects that we have to work with Quote
Jack_O'neill Posted January 25, 2009 Author Posted January 25, 2009 the rhombus is a block, and the rectangles are closed polylines. Well, most of the time. Sometimes they may be individual lines, but they are supposed to be closed polylines. We have some other software that extracts the length of these things for our cnc saw and it only looks for closed polylines on the "0" layer (I know, but I didn't write it). The rhombus is an indicator for the drill operator. His software picks up the location of this thing, and then the drilling machine puts in an assortment of holes or slots based on the location of that little block. When the rectangles are evenly spaced, I just array the blocks, but that's kinda hard to do when they are irregularly spaced. Sample objects have been included. Thanks. Drawing1.dwg Quote
Lee Mac Posted January 25, 2009 Posted January 25, 2009 Give this a test drive: ; Diamond ~ by Lee McDonnel [25.01.2009] ; Places a Diamond Block at the Intersection of a LWPolyline ; [Assumes Diamond Block Definition is in Drawing] (defun c:diamond (/ ss lEnt eLst sLin eLin pvert i int intLst) (vl-load-com) (if (and (setq ss (ssget '((0 . "LWPOLYLINE")))) (setq lEnt (car (entsel "\nSelect Intersecting Line > "))) (eq (cdr (assoc 0 (entget lEnt))) "LINE")) (progn (setq eLst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) sLin (cdr (assoc 10 (entget lEnt))) eLin (cdr (assoc 11 (entget lEnt)))) (foreach ent eLst (setq pVert (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget ent)))) (if (eq (setq i (length pVert)) 4) (progn (while (not (zerop (setq i (1- i)))) (if (setq int (inters sLin eLin (nth i pVert) (nth (1- i) pVert))) (setq intLst (cons int intLst)))) (setq intLst (vl-sort intLst '(lambda (x1 x2) (< (car x1) (car x2))))) (SetBlkTF "3ANSYMB") (entmake (list (cons 0 "INSERT") (cons 2 "3ANSYMB") (cons 10 (cadr intLst)))) (entmake (list (cons 0 "INSERT") (cons 2 "3ANSYMB") (cons 10 (cons (- (caar intLst) 6.5515) (cdar intLst))))))))) (princ "\n<!> No Line Selected, or this isn't a Line! <!>")) (princ)) (defun SetBlkTF (n) (cond ((not (snvalid n)) (princ "\nInvalid Block Name - " n) (exit)) ((tblsearch "BLOCK" n)) ((findfile (strcat n ".DWG")) (command "_.INSERT" n) (command)) (T ; If all else fails.... (entmake (list (cons 0 "BLOCK") (cons 2 n) (cons 10 (list 0 0 0)) (cons 70 0))) (entmake (list (cons 0 "TEXT") (cons 1 (strcat "BLOCK PLACECARD - " n)) (cons 7 (cdr (assoc 2 (tblnext "STYLE" T)))) (cons 8 "0") (cons 10 (list 0 0 0)) (cons 11 (list 0 0 0)) (cons 40 (max 1 (getvar "TEXTSIZE"))) (cons 72 4))) (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))))n) Quote
Lee Mac Posted January 25, 2009 Posted January 25, 2009 The above should work as per the example drawing you posted. But, as the base point of the diamond is on one side, the placement of the diamond had to be adjusted by a factor of the diamond's width (6.5515), therefore, the above code will not work for all generic "diamond" shapes. Quote
Jack_O'neill Posted January 25, 2009 Author Posted January 25, 2009 Lee, that is very impressive! Thank you very much! I do have one question though. It may be that I'm not doing something correctly. Just for test purposes, I put 4 of the vertical rectangles in the drawing, and drew a line across them. Loaded the code and started it. Here is the command line history: Command: DIAMOND Select objects: Specify opposite corner: 4 found Select objects: Select Intersecting Line > Command: but it only put the diamonds on the first one on the left. They are in the right place, but it didn't do all four. Am I not picking them correctly? I used a crossing. Again, thanks for your help. Quote
Lee Mac Posted January 25, 2009 Posted January 25, 2009 Hmmmm... not sure about that... See video: Diamond.zip Quote
Lee Mac Posted January 25, 2009 Posted January 25, 2009 An updated version to remove the Line: ; Diamond ~ by Lee McDonnel [25.01.2009] ; Places a Diamond Block at the Intersection of a LWPolyline ; [Assumes Diamond Block Definition is in Drawing] ; [updated to remove intersecting line] (defun c:diamond (/ ss lEnt eLst sLin eLin pvert i int intLst) (vl-load-com) (if (and (setq ss (ssget '((0 . "LWPOLYLINE")))) (setq lEnt (car (entsel "\nSelect Intersecting Line > "))) (eq (cdr (assoc 0 (entget lEnt))) "LINE")) (progn (setq eLst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) sLin (cdr (assoc 10 (entget lEnt))) eLin (cdr (assoc 11 (entget lEnt)))) (foreach ent eLst (setq pVert (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget ent)))) (if (eq (setq i (length pVert)) 4) (progn (while (not (zerop (setq i (1- i)))) (if (setq int (inters sLin eLin (nth i pVert) (nth (1- i) pVert))) (setq intLst (cons int intLst)))) (setq intLst (vl-sort intLst '(lambda (x1 x2) (< (car x1) (car x2))))) (SetBlkTF "3ANSYMB") (entmake (list (cons 0 "INSERT") (cons 2 "3ANSYMB") (cons 10 (cadr intLst)))) (entmake (list (cons 0 "INSERT") (cons 2 "3ANSYMB") (cons 10 (cons (- (caar intLst) 6.5515) (cdar intLst)))))))) (entdel lEnt)) (princ "\n<!> No Line Selected, or this isn't a Line! <!>")) (princ)) (defun SetBlkTF (n) (cond ((not (snvalid n)) (princ "\nInvalid Block Name - " n) (exit)) ((tblsearch "BLOCK" n)) ((findfile (strcat n ".DWG")) (command "_.INSERT" n) (command)) (T ; If all else fails.... (entmake (list (cons 0 "BLOCK") (cons 2 n) (cons 10 (list 0 0 0)) (cons 70 0))) (entmake (list (cons 0 "TEXT") (cons 1 (strcat "BLOCK PLACECARD - " n)) (cons 7 (cdr (assoc 2 (tblnext "STYLE" T)))) (cons 8 "0") (cons 10 (list 0 0 0)) (cons 11 (list 0 0 0)) (cons 40 (max 1 (getvar "TEXTSIZE"))) (cons 72 4))) (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))))n) Quote
Jack_O'neill Posted January 25, 2009 Author Posted January 25, 2009 that little movie is cool...how did you do that? anyway, i see what might be some of it...you're using 2004, i'm on 2007 here and 2008 at work. Quote
Lee Mac Posted January 25, 2009 Posted January 25, 2009 There shouldn't be too much of a difference between the versions - is there an error occuring? As for the video: http://www.microsoft.com/windows/windowsmedia/forpros/encoder/default.mspx Quote
Jack_O'neill Posted January 25, 2009 Author Posted January 25, 2009 that's the problem. I had a 2002 on another machine and it works on it, but not on the 2007 version. Quote
fixo Posted January 25, 2009 Posted January 25, 2009 Try another one First select all of the rectangles or vertical lines, assumed that all of these objects lies on layer "0" Then select the horizontal line Tested on A2008eng only Hth ;;hm.lsp (defun group-by-num (lst num / ls ret) (if (= (rem (length lst) num ) 0) (progn (setq ls nil) (repeat (/ (length lst) num) (repeat num (setq ls (cons (car lst) ls) lst (cdr lst))) (setq ret (append ret (list (reverse ls))) ls nil))) ) ret ) ;;holes markers (defun C:hm (/ acsp adoc axss bpt cnt en ipt obj oline points ss wid) (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object) ) ) ) (or acsp (setq acsp (vla-get-block (vla-get-activelayout adoc) ) ) ) (setq wid 6.5515) (if (and (setq ss (ssget '((0 . "LWPOLYLINE,LINE")(8 . "0"))));;select objects on layer "0" (setq en (entsel "\nSelect Intersecting Line > "))) (progn (setq axss (vla-get-activeselectionset adoc) oline (vlax-ename->vla-object (car en)) ) (vlax-for obj axss (if (not (vl-catch-all-error-p (setq ipt (vl-catch-all-apply (function (lambda() (vlax-invoke obj 'IntersectWith oline acextendnone)))))) ) (if (= (length ipt) 3) (setq points (append (list ipt) points)) (setq points (append (group-by-num ipt 3) points)) ))) (setq points (vl-sort points (function (lambda(a b)(< (car a)(car b)))))) (setq cnt 1) (while (setq ipt (car points)) (if (= (rem cnt 2) 1) (setq ipt (list (- (car ipt) wid)(cadr ipt)(caddr ipt))) ) (setq bpt (cons ipt bpt)) (setq points (cdr points)) (setq cnt (1+ cnt)) ) (while (setq ipt (car bpt)) (vlax-invoke acsp 'InsertBlock ipt "3ANSYMB" 1 1 1 0) (setq bpt (cdr bpt)) ) ) ) (princ) ) (vl-load-com) ~'J'~ Quote
Lee Mac Posted January 25, 2009 Posted January 25, 2009 Ahh right - I'm not quite sure why it doesn't work on 07 or 08, but you say it inserts on the first rectangle OK? Quote
Jack_O'neill Posted January 25, 2009 Author Posted January 25, 2009 It doesn't give an error message, it just acts like it thinks it's done. I tried it on another machine with 2002 on it, and it works there. Must be something different between the two versions. Thanks for your help with it...on the right version, that's exactly what I was looking for. I'm gonna try that movie stuff out too. That would be a great training tool. Quote
Lee Mac Posted January 25, 2009 Posted January 25, 2009 I'm puzzled now, because I didn't use any ACAD commands in the LISP - so it can't be a difference in the order of command prompts. But then I can't see what else it can be Fixo, any ideas? Quote
Jack_O'neill Posted January 25, 2009 Author Posted January 25, 2009 fixo...your version works on 2007. Thanks!! Quote
Jack_O'neill Posted January 25, 2009 Author Posted January 25, 2009 Lee, yes, your's puts it on the first rectangle on the left perfectly, then the routine ends just as if it finished normally. No error message, doesn't hesitate...it thinks its done. Your's does work correctly on an 2002 machine tho....got to be some difference in the version. Quote
Lee Mac Posted January 25, 2009 Posted January 25, 2009 Perhaps Fixo can offer some insight - anyway, glad your problem is sorted now - I bet that'll save you some time! Quote
fixo Posted January 25, 2009 Posted January 25, 2009 Perhaps Fixo can offer some insight - anyway, glad your problem is sorted now - I bet that'll save you some time! Hi mate Sorry I can't explain you about how this code works because of my poor English I'm just a coder and nothing else ~'J'~ Quote
Lee Mac Posted January 25, 2009 Posted January 25, 2009 Hi mateSorry I can't explain you about how this code works because of my poor English I'm just a coder and nothing else ~'J'~ No Probs, nice code by the way Quote
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.