Jump to content

Recommended Posts

Posted

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. :(

Posted

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.

Posted

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

Posted

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

Posted

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]

           

 

Posted

Some fun with GrRead :P :

 

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

Posted

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.

Posted
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.

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...