Jump to content

place objects with lisp or vba


Recommended Posts

Posted

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.

lisp1.jpg

  • Replies 26
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    13

  • Jack_O'neill

    11

  • fixo

    3

Top Posters In This Topic

Posted Images

Posted

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 :)

Posted

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

Posted

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)

Posted

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.

Posted

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.

Posted

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)

Posted

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.

Posted

that's the problem. I had a 2002 on another machine and it works on it, but not on the 2007 version.

Posted

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'~

Posted

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?

Posted

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.

Posted

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 :huh:

 

Fixo, any ideas?

Posted

fixo...your version works on 2007. Thanks!!

Posted

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.

Posted

Perhaps Fixo can offer some insight - anyway, glad your problem is sorted now - I bet that'll save you some time! :)

Posted
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'~

Posted
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'~

 

No Probs, nice code by the way :thumbsup:

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...