Ocron Posted March 11, 2010 Posted March 11, 2010 A friend asked me to create a lisp routine for him that I can't figure out how to do. I've seen one like it before but I'm not advanced enough to know the exacts on how to create it. What he wants is simple. To type in a block ((He wants it for Text) so if it's easier to do text let me know) name and select a line he wants to put it on. From there the lisp would align the block on the line as well as trim the line just outside the boundaries of the block/text. I know how to do everything in the lisp routine except for the trim. I don't know how to get it where it looks up a distance of the block. The program I saw like this would find that info draw a line from the center of the block, offset it, trim in between and then erase the lines it created. If there is an easier way then that would be awesome. But I can't figure this one out. Quote
Ocron Posted March 11, 2010 Author Posted March 11, 2010 Thank you Lee Mac that actually does exactly what I needed. But dang looking at that code I'm completely lost. I'm still a beginner in Autolisp so I'm still doing basic stuff with it. At least I get to have fun looking up and figuring out exactly what Vla and Vlax are in autolisp since I've never seen that one till now. Thanks again. Quote
Lee Mac Posted March 11, 2010 Posted March 11, 2010 Hi Ocron, Yes, its probably a bit overkill for someone who just starting. The VL* functions are part of Visual LISP, (an extension of Vanilla LISP, with a mixture of additional functions and VBA methods). The code basically prompts for a block and pt, and then inserts the block at Zero rotation. It then gets the BoundingBox of the block object, (the box that would contain the block completely), and gets its width. If the user has clicked a point that lies on an object, the first derivative (hence the slope) of the object is retrieved for the selected point, and the block is oriented to that angle. The code then breaks the object at a distance that is half the width of the BoundingBox. Of course, the code is not 100% fool-proof, as it assumes that the insertion point is central in the block, and that the block doesn't have edges that protrude further than the points at which it needs to be trimmed. But it will work in the majority of cases. Lee Quote
Ocron Posted March 11, 2010 Author Posted March 11, 2010 Yes it seems to work just fine for what he needed. But me being the person I am and always experimenting. I wonder if I could make it so if you used the measure command it would put this block at certain lengths along a PL and trim it.... Nah probably not considering evertime it breaks the line the polyline would become two different entities and the measures would probably be thrown off. I'll have to try a couple different things and see how it goes. Quote
Lee Mac Posted March 11, 2010 Posted March 11, 2010 This might be better actually Ocron: [i][color=#990099];; Auto Block Break ~ Lee Mac 11.03.10[/color][/i] [i][color=#990099];; Will trim objects by rectangular block width at zero rotation.[/color][/i] [i][color=#990099];; Assumes central block base point.[/color][/i] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:ins [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] *error* ANG BNME DIS ENT GETNAME LST MAXP MINP OBJ OVARS PT UFLAG VLST[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] *error* [b][color=RED]([/color][/b]msg[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndoMark[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] oVars [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]setvar[/color][color=RED])[/color][/b] vLst oVars[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] msg[b][color=RED])[/color][/b] [b][color=#a52a2a]"*BREAK,*CANCEL*,*EXIT*"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\n** Error: "[/color][/b] msg [b][color=#a52a2a]" **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] *doc [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b]*doc[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-Acad-Object[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] vLst [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#a52a2a]"CMDECHO"[/color][/b] [b][color=#a52a2a]"OSMODE"[/color][/b][b][color=RED])[/color][/b] oVars [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] getvar[b][color=RED])[/color][/b] vLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] GetName [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]obj[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-property-available-p[/color][/b] obj [b][color=DARKRED]'[/color][/b]EffectiveName[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-EffectiveName[/color][/b] obj[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Name[/color][/b] obj[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]initget[/color][/b] [b][color=#009900]128[/color][/b] [b][color=#a52a2a]"Browse"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bNme [b][color=RED]([/color][/b][b][color=BLUE]getkword[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\nSpecify Block Name [browse] <"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=DARKRED]'[/color][/b]INSNAME[b][color=RED])[/color][/b] [b][color=#a52a2a]"> : "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] bNme[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#a52a2a]""[/color][/b] bNme[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bNme [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=DARKRED]'[/color][/b]INSNAME[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=BLUE]nil[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#a52a2a]"Browse"[/color][/b] bNme[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bNme [b][color=RED]([/color][/b][b][color=BLUE]getfiled[/color][/b] [b][color=#a52a2a]"Select Block"[/color][/b] [b][color=#a52a2a]""[/color][/b] [b][color=#a52a2a]"dwg"[/color][/b] [b][color=#009900]16[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]snvalid[/color][/b] bNme[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]tblsearch[/color][/b] [b][color=#a52a2a]"BLOCK"[/color][/b] bNme[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bNme [b][color=RED]([/color][/b][b][color=BLUE]findfile[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] bNme [b][color=#a52a2a]".dwg"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=BLUE]nil[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]t[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#a52a2a]"\n** Invalid Block Specification **"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] pt [b][color=RED]([/color][/b][b][color=BLUE]getpoint[/color][/b] [b][color=#a52a2a]"\nSpecify Point for Block: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-StartUndoMark[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b] Obj [b][color=RED]([/color][/b][b][color=BLUE]vla-InsertBlock[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=Blue]AcModelSpace [/color][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveSpace[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [color=Blue][b]:vlax-true[/b][/color] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-MSpace[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ModelSpace[/color][/b] *doc[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-PaperSpace[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-3D-point[/color][/b] pt[b][color=RED])[/color][/b] bNme [b][color=#009999]1.[/color][/b] [b][color=#009999]1.[/color][/b] [b][color=#009999]1.[/color][/b] [b][color=#009999]0.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setvar[/color][/b] [b][color=#a52a2a]"INSNAME"[/color][/b] [b][color=RED]([/color][/b]GetName Obj[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]nentselp[/color][/b] pt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-catch-all-error-p[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] pt [b][color=RED]([/color][/b][b][color=BLUE]vl-catch-all-apply[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]vlax-curve-getClosestPointto[/color][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] ent pt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-getBoundingBox[/color][/b] Obj [b][color=DARKRED]'[/color][/b]Minp [b][color=DARKRED]'[/color][/b]Maxp[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lst [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]vlax-safearray->list[/color][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] Minp Maxp[b][color=RED])[/color][/b][b][color=RED])[/color][/b] dis [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]caadr[/color][/b] lst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]caar[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-put-Rotation[/color][/b] Obj [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ang [b][color=RED]([/color][/b][b][color=BLUE]angle[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] [b][color=#009900]0[/color][/b] [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getFirstDeriv[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getParamatPoint[/color][/b] ent pt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]setvar[/color][color=RED])[/color][/b] vLst [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]command[/color][/b] [b][color=#a52a2a]"_.break"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] ent pt[b][color=RED])[/color][/b] [b][color=#a52a2a]"_F"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]osnap[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] pt ang [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] dis [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#a52a2a]"_nea"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]osnap[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] pt ang [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] dis [b][color=#009999]-2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#a52a2a]"_nea"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]setvar[/color][color=RED])[/color][/b] vLst oVars[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] uFlag [b][color=RED]([/color][/b][b][color=BLUE]vla-EndUndomark[/color][/b] *doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] Quote
Lee Mac Posted March 11, 2010 Posted March 11, 2010 Some fun with GrRead : ;; Auto Block Break ~ Lee Mac 11.03.10 ;; Will trim objects by rectangular block width at zero rotation. ;; Assumes central block base point. (defun c:ins (/ *error* ANG BNME CPT DIS ENT GETNAME GR LST MAXP MINP OBJ OVARS PT UFLAG VLST) (vl-load-com) (defun *error* (msg) (and uFlag (vla-EndUndoMark *doc)) (and oVars (mapcar (function setvar) vLst oVars)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-Acad-Object)))) vLst '("CMDECHO" "OSMODE") oVars (mapcar (function getvar) vLst)) (setq GetName (lambda (obj) (if (vlax-property-available-p obj 'EffectiveName) (vla-get-EffectiveName obj) (vla-get-Name obj)))) (while (progn (initget 128 "Browse") (setq bNme (getkword (strcat "\nSpecify Block Name [browse] <" (getvar 'INSNAME) "> : "))) (cond ( (or (not bNme) (eq "" bNme)) (setq bNme (getvar 'INSNAME)) nil) ( (eq "Browse" bNme) (not (setq bNme (getfiled "Select Block" "" "dwg" 16)))) ( (and (snvalid bNme) (or (tblsearch "BLOCK" bNme) (setq bNme (findfile (strcat bNme ".dwg"))))) nil) (t (princ "\n** Invalid Block Specification **"))))) (while (progn (setq ent (entsel "\nSelect Object to Align Block to: ")) (cond ( (eq 'ENAME (type (car ent))) (if (vl-catch-all-error-p (setq pt (vl-catch-all-apply (function vlax-curve-getClosestPointto) (list (car ent) (cadr ent))))) (princ "\n** Invalid Object **")))))) (if (setq ent (car ent)) (progn (setq uFlag (not (vla-StartUndoMark *doc)) Obj (vla-InsertBlock (if (or (eq AcModelSpace (vla-get-ActiveSpace *doc)) (eq :vlax-true (vla-get-MSpace *doc))) (vla-get-ModelSpace *doc) (vla-get-PaperSpace *doc)) (vlax-3D-point pt) bNme 1. 1. 1. 0.)) (setvar "INSNAME" (GetName Obj)) (vla-getBoundingBox Obj 'Minp 'Maxp) (setq lst (mapcar (function vlax-safearray->list) (list Minp Maxp)) dis (- (caadr lst) (caar lst))) (while (and (= 5 (car (setq gr (grread 't 13 0)))) (listp (setq cPt (cadr gr)))) (vlax-put-property Obj 'InsertionPoint (vlax-3D-point (setq pt (vlax-curve-getClosestPointto ent cPt)))) (vlax-put-property Obj 'Rotation (setq ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent pt)))))) (mapcar (function setvar) vLst '(0 0)) (command "_.break" (list ent pt) "_F" (osnap (polar pt ang (/ dis 2.)) "_nea") (osnap (polar pt ang (/ dis -2.)) "_nea")) (mapcar (function setvar) vLst oVars) (setq uFlag (vla-EndUndomark *doc)))) (princ)) Quote
Ocron Posted March 11, 2010 Author Posted March 11, 2010 Nice I like that. So it allows you to move the object anywhere along the line. I like that better then the original. Can have a lot fun with that one. Quote
Lee Mac Posted March 11, 2010 Posted March 11, 2010 Nice I like that. So it allows you to move the object anywhere along the line. I like that better then the original. Can have a lot fun with that one. True - I love the GrRead functionality - but it doesn't permit standard AutoCAD functionality such as OSnap/Polar/Tracking/Orthomode etc within the loop. 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.