Lee Mac Posted July 17, 2009 Posted July 17, 2009 Another way to approach it, assumes the basepoint is in the center of the block. (can be modified if not). Update the information at the top as necessary: (defun c:brklin (/ *error* bNme bLen vl ov doc spc pt ent lAng) (vl-load-com) [b][color=Red] (setq bNme "Test Block") ;; <<-- Block Name (setq bLen 90) ;; <<-- Block Length[/color][/b] (defun *error* (msg) (if ov (mapcar 'setvar vl ov)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " msg " >>"))) (princ)) (setq vl '("CMDECHO" "OSMODE") ov (mapcar 'getvar vl)) (or (eq 512 (logand 512 (getvar 'OSMODE))) (setvar 'OSMODE (+ (getvar 'OSMODE) 512))) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (cond ((not (snvalid bNme)) (princ "\n** Block Name Invalid **")) ((not (or (tblsearch "BLOCK" bNme) (findfile (strcat bNme ".dwg")))) (princ "\n** Block Not Found **")) ((not (numberp bLen)) (princ "\n** Block Length not Numerical **")) (t (while (progn (setq pt (getpoint "\nSelect Point for Block: ")) (cond ((not pt) nil) ((setq ent (car (nentselp pt))) (if (not (wcmatch (cdr (assoc 0 (entget ent))) "*LINE")) (princ "\n** Cannot Align to that Object **"))) (t (princ "\n** Point Does not Lie on an Object **"))))) (if ent (progn (setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent pt)))) (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (setq pt1 (polar pt lAng (/ bLen 2.)) pt2 (polar pt (+ lAng pi) (/ bLen 2.))) (mapcar 'setvar vl '(0 0)) (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda ( ) (vla-InsertBlock spc (vlax-3D-point pt) bNme 1. 1. 1. lAng))))) (princ "\n** Error Inserting Block **") (command "_.break" (list ent pt) "_F" pt1 pt2)))))) (mapcar 'setvar vl ov) (princ)) Quote
The Buzzard Posted July 17, 2009 Posted July 17, 2009 Another way to approach it, assumes the basepoint is in the center of the block. (can be modified if not). Update the information at the top as necessary: (defun c:brklin (/ *error* bNme bLen vl ov doc spc pt ent lAng) (vl-load-com) [b][color=red] (setq bNme "Test Block") ;; <<-- Block Name[/color][/b] [b][color=red] (setq bLen 90) ;; <<-- Block Length[/color][/b] (defun *error* (msg) (if ov (mapcar 'setvar vl ov)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " msg " >>"))) (princ)) (setq vl '("CMDECHO" "OSMODE") ov (mapcar 'getvar vl)) (or (eq 512 (logand 512 (getvar 'OSMODE))) (setvar 'OSMODE (+ (getvar 'OSMODE) 512))) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (cond ((not (snvalid bNme)) (princ "\n** Block Name Invalid **")) ((not (or (tblsearch "BLOCK" bNme) (findfile (strcat bNme ".dwg")))) (princ "\n** Block Not Found **")) ((not (numberp bLen)) (princ "\n** Block Length not Numerical **")) (t (while (progn (setq pt (getpoint "\nSelect Point for Block: ")) (cond ((not pt) nil) ((setq ent (car (nentselp pt))) (if (not (wcmatch (cdr (assoc 0 (entget ent))) "*LINE")) (princ "\n** Cannot Align to that Object **"))) (t (princ "\n** Point Does not Lie on an Object **"))))) (if ent (progn (setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent pt)))) (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (setq pt1 (polar pt lAng (/ bLen 2.)) pt2 (polar pt (+ lAng pi) (/ bLen 2.))) (mapcar 'setvar vl '(0 0)) (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda ( ) (vla-InsertBlock spc (vlax-3D-point pt) bNme 1. 1. 1. lAng))))) (princ "\n** Error Inserting Block **") (command "_.break" (list ent pt) "_F" pt1 pt2)))))) (mapcar 'setvar vl ov) (princ)) Lee that is outstanding! Maybe I better learn VL after all. Quote
Lee Mac Posted July 17, 2009 Posted July 17, 2009 Lee that is outstanding! Maybe I better learn VL after all. Thanks Buzzard - tbh I could've written the code just using "command" calls - but VL is more bullet-proof when it comes to error trapping Quote
The Buzzard Posted July 17, 2009 Posted July 17, 2009 Thanks Buzzard - tbh I could've written the code just using "command" calls - but VL is more bullet-proof when it comes to error trapping I am not sure what you mean by that, But I will take your word on it. There is not much needed in that code to configure it for any kind of block. It a very versatile code. You should archive it with the rest of you Masterpieces. Quote
Lee Mac Posted July 17, 2009 Posted July 17, 2009 I am not sure what you mean by that, But I will take your word on it. Well, I mean that, for instance, instead of using vla-insertblock, I could use (command "_.-insert"... and instead of getting the angle of the object through VL, I could have worked with DXF codes There is not much needed in that code to configure it for any kind of block. It a very versatile code. You should archive it with the rest of you Masterpieces. Thanks Buzzard, I have about 907 lisps on my computer at the moment... and those are just the ones I've bothered saving... they soon rack up Quote
The Buzzard Posted July 17, 2009 Posted July 17, 2009 Well, I mean that, for instance, instead of using vla-insertblock, I could use (command "_.-insert"... and instead of getting the angle of the object through VL, I could have worked with DXF codes Thanks Buzzard, I have about 907 lisps on my computer at the moment... and those are just the ones I've bothered saving... they soon rack up Actually I understood you about the command calls. I was not sure about the error trapping part. It would seem more complex to me, But that is only because I have not bothered to learn it. I have Afralisp Visual Lisp tutorial section open now. A good starting point for me. If I get thru that, I will be researching much further into it. Quote
Lee Mac Posted July 17, 2009 Posted July 17, 2009 Good luck - If you need any help at all with it, just shout Quote
The Buzzard Posted July 17, 2009 Posted July 17, 2009 Good luck - If you need any help at all with it, just shout Lee, Would it be a bother to set this program up to the image below. Quote
Lee Mac Posted July 17, 2009 Posted July 17, 2009 Certainly not a trouble: (defun c:brklin (/ *error* bNme bLen vl ov doc spc pt ent lAng pt2) (vl-load-com) [color=Red][b] (setq bNme "Test Block") ;; <<-- Block Name (setq bLen 90) ;; <<-- Block Length [/b][/color] (defun *error* (msg) (if ov (mapcar 'setvar vl ov)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " msg " >>"))) (princ)) (setq vl '("CMDECHO" "OSMODE") ov (mapcar 'getvar vl)) (or (eq 512 (logand 512 (getvar 'OSMODE))) (setvar 'OSMODE (+ (getvar 'OSMODE) 512))) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (cond ((not (snvalid bNme)) (princ "\n** Block Name Invalid **")) ((not (or (tblsearch "BLOCK" bNme) (findfile (strcat bNme ".dwg")))) (princ "\n** Block Not Found **")) ((not (numberp bLen)) (princ "\n** Block Length not Numerical **")) (t (while (progn (setq pt (getpoint "\nSelect Point for Block: ")) (cond ((not pt) nil) ((setq ent (car (nentselp pt))) (if (not (wcmatch (cdr (assoc 0 (entget ent))) "*LINE")) (princ "\n** Cannot Align to that Object **"))) (t (princ "\n** Point Does not Lie on an Object **"))))) (if ent (progn (setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent pt)))) (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) [b][color=Red] (setq pt2 (polar pt lAng bLen))[/color][/b] (mapcar 'setvar vl '(0 0)) (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda ( ) (vla-InsertBlock spc (vlax-3D-point pt) (strcat bNme ".dwg") 1. 1. 1. lAng))))) (princ "\n** Error Inserting Block **") (command "_.break" (list ent pt) "_F" [b][color=Red]pt[/color][/b] pt2)))))) (mapcar 'setvar vl ov) (princ)) Changes highlighted Quote
The Buzzard Posted July 17, 2009 Posted July 17, 2009 Certainly not a trouble: (defun c:brklin (/ *error* bNme bLen vl ov doc spc pt ent lAng pt2) (vl-load-com) [color=red][b] (setq bNme "Test Block") ;; <<-- Block Name[/b][/color] [b][color=red] (setq bLen 90) ;; <<-- Block Length[/color][/b] (defun *error* (msg) (if ov (mapcar 'setvar vl ov)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " msg " >>"))) (princ)) (setq vl '("CMDECHO" "OSMODE") ov (mapcar 'getvar vl)) (or (eq 512 (logand 512 (getvar 'OSMODE))) (setvar 'OSMODE (+ (getvar 'OSMODE) 512))) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (cond ((not (snvalid bNme)) (princ "\n** Block Name Invalid **")) ((not (or (tblsearch "BLOCK" bNme) (findfile (strcat bNme ".dwg")))) (princ "\n** Block Not Found **")) ((not (numberp bLen)) (princ "\n** Block Length not Numerical **")) (t (while (progn (setq pt (getpoint "\nSelect Point for Block: ")) (cond ((not pt) nil) ((setq ent (car (nentselp pt))) (if (not (wcmatch (cdr (assoc 0 (entget ent))) "*LINE")) (princ "\n** Cannot Align to that Object **"))) (t (princ "\n** Point Does not Lie on an Object **"))))) (if ent (progn (setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent pt)))) (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) [b][color=red] (setq pt2 (polar pt lAng bLen))[/color][/b] (mapcar 'setvar vl '(0 0)) (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda ( ) (vla-InsertBlock spc (vlax-3D-point pt) (strcat bNme ".dwg") 1. 1. 1. lAng))))) (princ "\n** Error Inserting Block **") (command "_.break" (list ent pt) "_F" [b][color=red]pt[/color][/b] pt2)))))) (mapcar 'setvar vl ov) (princ)) Changes highlighted First, Thank You. Second, I get this error Command: BRKLIN Select Point for Block: ** Error Inserting Block ** Command: Quote
Lee Mac Posted July 17, 2009 Posted July 17, 2009 Hmmm.. I cannot seem to replicate that. Few things: The Block must be in the search path, or in the drawing itself. The Name at the top should only be a name, (with no path or extension). Quote
The Buzzard Posted July 17, 2009 Posted July 17, 2009 Hmmm.. I cannot seem to replicate that. Few things: The Block must be in the search path, or in the drawing itself. The Name at the top should only be a name, (with no path or extension). I have it in the drawing itself. I even tried changing the characters. I closed out the drawing and reloaded the code and got the same thing. Attached below is the drawing. BREAK-LIN.dwg Quote
Lee Mac Posted July 17, 2009 Posted July 17, 2009 Ok I think i know what it was, try this: (defun c:brklin (/ *error* bNme bLen vl ov doc spc pt ent lAng pt2) (vl-load-com) (setq bNme "Test Block") ;; <<-- Block Name (setq bLen 90) ;; <<-- Block Length (defun *error* (msg) (if ov (mapcar 'setvar vl ov)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " msg " >>"))) (princ)) (setq vl '("CMDECHO" "OSMODE") ov (mapcar 'getvar vl)) (or (eq 512 (logand 512 (getvar 'OSMODE))) (setvar 'OSMODE (+ (getvar 'OSMODE) 512))) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (cond ((not (snvalid bNme)) (princ "\n** Block Name Invalid **")) ((not (or (tblsearch "BLOCK" bNme) (setq bNme (findfile (strcat bNme ".dwg"))))) (princ "\n** Block Not Found **")) ((not (numberp bLen)) (princ "\n** Block Length not Numerical **")) (t (while (progn (setq pt (getpoint "\nSelect Point for Block: ")) (cond ((not pt) nil) ((setq ent (car (nentselp pt))) (if (not (wcmatch (cdr (assoc 0 (entget ent))) "*LINE")) (princ "\n** Cannot Align to that Object **"))) (t (princ "\n** Point Does not Lie on an Object **"))))) (if ent (progn (setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent pt)))) (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (setq pt2 (polar pt lAng bLen)) (mapcar 'setvar vl '(0 0)) (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda ( ) (vla-InsertBlock spc (vlax-3D-point pt) bNme 1. 1. 1. lAng))))) (princ "\n** Error Inserting Block **") (command "_.break" (list ent pt) "_F" pt pt2)))))) (mapcar 'setvar vl ov) (princ)) Quote
The Buzzard Posted July 17, 2009 Posted July 17, 2009 Ok I think i know what it was, try this: (defun c:brklin (/ *error* bNme bLen vl ov doc spc pt ent lAng pt2) (vl-load-com) (setq bNme "Test Block") ;; <<-- Block Name (setq bLen 90) ;; <<-- Block Length (defun *error* (msg) (if ov (mapcar 'setvar vl ov)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " msg " >>"))) (princ)) (setq vl '("CMDECHO" "OSMODE") ov (mapcar 'getvar vl)) (or (eq 512 (logand 512 (getvar 'OSMODE))) (setvar 'OSMODE (+ (getvar 'OSMODE) 512))) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (cond ((not (snvalid bNme)) (princ "\n** Block Name Invalid **")) ((not (or (tblsearch "BLOCK" bNme) (setq bNme (findfile (strcat bNme ".dwg"))))) (princ "\n** Block Not Found **")) ((not (numberp bLen)) (princ "\n** Block Length not Numerical **")) (t (while (progn (setq pt (getpoint "\nSelect Point for Block: ")) (cond ((not pt) nil) ((setq ent (car (nentselp pt))) (if (not (wcmatch (cdr (assoc 0 (entget ent))) "*LINE")) (princ "\n** Cannot Align to that Object **"))) (t (princ "\n** Point Does not Lie on an Object **"))))) (if ent (progn (setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent pt)))) (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (setq pt2 (polar pt lAng bLen)) (mapcar 'setvar vl '(0 0)) (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda ( ) (vla-InsertBlock spc (vlax-3D-point pt) bNme 1. 1. 1. lAng))))) (princ "\n** Error Inserting Block **") (command "_.break" (list ent pt) "_F" pt pt2)))))) (mapcar 'setvar vl ov) (princ)) Great! That did the trick! My curiosity in this was, I want to see if you placed the block on an endpoint of the line, Would the line break or would you get an error. I was messing around with a conventional code with the insertion point to the left and could not get the line to break if I placed it at the endpoint. If I placed it on the line anywhere else it would break, But not correctly. I think I just screwed it up to be honest. I want to see how your code would work in the same situation. No problems! I guess it back to the drawing board. Thanks Alot, Now I can find out what I did wrong. I hope. The Buzzard Quote
Lee Mac Posted July 17, 2009 Posted July 17, 2009 I'm glad it works If you do get stuck at all with your code, or understanding mine, just shout. Lee Quote
The Buzzard Posted July 17, 2009 Posted July 17, 2009 I'm glad it works If you do get stuck at all with your code, or understanding mine, just shout. Lee Thanks I appreciate that alot. While trying to read up on VL I find it somewhat confusing on Afralisp since Kenny seems to take some shortcuts. It a bit watered down, So I need to read it over several times to get something out it. Rome was'nt built in a day. On second thought. Quote
Lee Mac Posted July 17, 2009 Posted July 17, 2009 tbh, I didn't use AfraLISP to learn VL - I used the peoples code on here and the Visual LISP Editor help files. I also find that AfraLISP skirts round the edges a bit. This would be my recommendation to get you started: Take a look at this function - its probably THE most useful function VL has to offer: (vlax-dump-object <VLA-Object> [Check/Modify]) This, if supplied with a VLA-Object (the VL alternative to an Entity Name), will list all the properties and methods that apply to that object. Properties are things such as layer, linetype etc Methods are thing you can do to the object, like copying, deleting... etc This is the code I use almost every time I write a complex LISP: (defun c:dump (/ ent obj) (setq ent (entsel "\nSelect entity to get object data: ")) (print) (setq obj (vlax-ename->vla-object (car ent))) (vlax-dump-object obj t) (vlax-release-object obj) (textscr) (princ "\n") (princ)) Try it out on a few objects... you will see what I mean. Next, you could start on the very basic things, like changing the properties (providing they are not Read-Only (RO) ). Like, changing the layer for example: (defun c:clay (/ ent Obj) (vl-load-com) ;; This must be called once per drawing session ;; so that the VL functions can be used. Multiple ;; calls just return nil, so theres no harm in ;; including it in your code. (if (setq ent (car (entsel "\nSelect Object: "))) (progn ;; ^^ That bit you know! (setq Obj (vlax-ename->vla-object ent)) ;; We've got to convert the entity into a VLA-Object ;; before we can use the VL functions on it. (vla-put-layer Obj "0") ;; and yes, its as simple as that. ) ; end progn ) ; End IF (princ)) Hope this helps you get started And, of course, if you do not understand what I have posted in this post, please do not hesitate to ask. Lee Quote
The Buzzard Posted July 17, 2009 Posted July 17, 2009 tbh, I didn't use AfraLISP to learn VL - I used the peoples code on here and the Visual LISP Editor help files. I also find that AfraLISP skirts round the edges a bit. This would be my recommendation to get you started: Take a look at this function - its probably THE most useful function VL has to offer: (vlax-dump-object <VLA-Object> [Check/Modify]) This, if supplied with a VLA-Object (the VL alternative to an Entity Name), will list all the properties and methods that apply to that object. Properties are things such as layer, linetype etc Methods are thing you can do to the object, like copying, deleting... etc This is the code I use almost every time I write a complex LISP: (defun c:dump (/ ent obj) (setq ent (entsel "\nSelect entity to get object data: ")) (print) (setq obj (vlax-ename->vla-object (car ent))) (vlax-dump-object obj t) (vlax-release-object obj) (textscr) (princ "\n") (princ)) Try it out on a few objects... you will see what I mean. Next, you could start on the very basic things, like changing the properties (providing they are not Read-Only (RO) ). Like, changing the layer for example: (defun c:clay (/ ent Obj) (vl-load-com) ;; This must be called once per drawing session ;; so that the VL functions can be used. Multiple ;; calls just return nil, so theres no harm in ;; including it in your code. (if (setq ent (car (entsel "\nSelect Object: "))) (progn ;; ^^ That bit you know! (setq Obj (vlax-ename->vla-object ent)) ;; We've got to convert the entity into a VLA-Object ;; before we can use the VL functions on it. (vla-put-layer Obj "0") ;; and yes, its as simple as that. ) ; end progn ) ; End IF (princ)) Hope this helps you get started And, of course, if you do not understand what I have posted in this post, please do not hesitate to ask. Lee Afralisp did touch on that subject a bit, But what you have here is a more clear and practical example. I will find this useful. Thanks Quote
cabltv1 Posted July 17, 2009 Author Posted July 17, 2009 Lee, You are really, really good at this. Not only did you come up with what I was asking for, you put an automatic block rotation into the code. Marvelous! I do have one question though. When I run the routine and the block is inserted, it leaves a bit of each line inside the block. Can you tell me which part of the code has the line break (distance/trim) so I can modify it for this block and any other blocks (different sizes) I decide to use this code on? By the way, I used the code on page 3 at the top as the block I am currently using this on has a Center insertion point. Could you also tell me where in the code the "Insertion Point" is. THANKS AGAIN! It will be a sad day once you stop coming to this site! Quote
The Buzzard Posted July 17, 2009 Posted July 17, 2009 cabltv, At the top of the code Lee placed a comment for the distance. You can change it there. (defun c:brklin (/ *error* bNme bLen vl ov doc spc pt ent lAng pt2) (vl-load-com) (setq bNme "Test Block") ;; <<-- Block Name [color=red](setq bLen 90) ;; <<-- Block Length[/color] 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.