Insert a block at multiple points or lines and scale

[Lee Mac]

I think you mean here is the solution.

 

........

[grouch19]

Thanks Lee

Works perfectly!

 

Thanks BIGAL for all your help too.

 

Appreciate the help guys!

[Ajmal]

Dear Lee

when i run the code its showing

; error: extra cdrs in dotted pair on input

(defun c:insblk ( / blk cmd dwg ent enx idx lst scl sel )

   (setq blk "Manhole") ;; Block Name

   (cond
       (   (not
               (or (tblsearch "block" blk)
                   (and (setq dwg (findfile (strcat blk ".dwg")))
                       (progn
                           (setq cmd (getvar 'cmdecho))
                           (setvar 'cmdecho 0)
                           (command "_.-insert" dwg nil)
                           (setvar 'cmdecho cmd)
                           (tblsearch "block" blk)
                       )
                   )
               )
           )
           (princ (strcat "\nBlock \"" blk "\" not found or could not be defined."))
       )
       (   (setq sel (ssget "_:L" '((0 . "POLYLINE") (-4. "&=")(70 . (-4 . "<NOT")(-4 . "&=")(70 . 1)(-4 . "NOT>"))))
           (repeat (setq idx (sslength sel))
               (setq ent (entnext (ssname sel (setq idx (1- idx))))
                     enx (entget ent)
                     lst nil
               )
               (while (= "VERTEX" (cdr (assoc 0 enx)))
                   (setq lst (cons (cdr (assoc 10 enx)) lst)
                         ent (entnext ent)
                         enx (entget  ent)
                   )
               )
               (if (= 3 (length lst))
                   (progn
                       (if (apply '< (setq scl (mapcar 'distance lst (cdr lst))))
                           (setq lst (reverse lst)
                                 scl (reverse scl)
                           )
                       )
                       (if (minusp (sin (- (angle (car lst) (caddr lst)) (angle (car lst) (cadr lst)))))
                           (setq lst (vl-list* (cadr lst) (car lst) (cddr lst)))
                       )
                       (if (entmake
                               (list
                                  '(000 . "INSERT")
                                   (cons 002 blk)
                                   (cons 010 (car  lst))
                                   (cons 041 (car  scl))
                                   (cons 042 (cadr scl))
                                   (cons 050 (angle (car lst) (cadr lst)))
                               )
                           )
                           (entdel (ssname sel idx))
                       )
                   )
               )
           )
       )
   )
   (princ)
))

 

[Kvlar]

On 3/11/2017 at 11:35 PM, Lee Mac said:

Based on your sample drawing, here is my attempt:

 

([color=BLUE]defun[/color] c:insblk ( [color=BLUE]/[/color] blk cmd dwg ent enx idx lst scl sel )

   ([color=BLUE]setq[/color] blk [color=MAROON]"Manhole"[/color]) [color=GREEN];; Block Name[/color]

   ([color=BLUE]cond[/color]
       (   ([color=BLUE]not[/color]
               ([color=BLUE]or[/color] ([color=BLUE]tblsearch[/color] [color=MAROON]"block"[/color] blk)
                   ([color=BLUE]and[/color] ([color=BLUE]setq[/color] dwg ([color=BLUE]findfile[/color] ([color=BLUE]strcat[/color] blk [color=MAROON]".dwg"[/color])))
                       ([color=BLUE]progn[/color]
                           ([color=BLUE]setq[/color] cmd ([color=BLUE]getvar[/color] 'cmdecho))
                           ([color=BLUE]setvar[/color] 'cmdecho 0)
                           ([color=BLUE]command[/color] [color=MAROON]"_.-insert"[/color] dwg [color=BLUE]nil[/color])
                           ([color=BLUE]setvar[/color] 'cmdecho cmd)
                           ([color=BLUE]tblsearch[/color] [color=MAROON]"block"[/color] blk)
                       )
                   )
               )
           )
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nBlock \""[/color] blk [color=MAROON]"\" not found or could not be defined."[/color]))
       )
       (   ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"POLYLINE"[/color]) (-4 . [color=MAROON]"&="[/color]) (70 .  (-4 . [color=MAROON]"<NOT"[/color]) (-4 . [color=MAROON]"&="[/color]) (70 . 1) (-4 . [color=MAROON]"NOT>"[/color]))))
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] idx ([color=BLUE]sslength[/color] sel))
               ([color=BLUE]setq[/color] ent ([color=BLUE]entnext[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] idx ([color=BLUE]1-[/color] idx))))
                     enx ([color=BLUE]entget[/color] ent)
                     lst [color=BLUE]nil[/color]
               )
               ([color=BLUE]while[/color] ([color=BLUE]=[/color] [color=MAROON]"VERTEX"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 enx)))
                   ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 enx)) lst)
                         ent ([color=BLUE]entnext[/color] ent)
                         enx ([color=BLUE]entget[/color]  ent)
                   )
               )
               ([color=BLUE]if[/color] ([color=BLUE]=[/color] 3 ([color=BLUE]length[/color] lst))
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]if[/color] ([color=BLUE]apply[/color] '[color=BLUE]<[/color] ([color=BLUE]setq[/color] scl ([color=BLUE]mapcar[/color] '[color=BLUE]distance[/color] lst ([color=BLUE]cdr[/color] lst))))
                           ([color=BLUE]setq[/color] lst ([color=BLUE]reverse[/color] lst)
                                 scl ([color=BLUE]reverse[/color] scl)
                           )
                       )
                       ([color=BLUE]if[/color] ([color=BLUE]minusp[/color] ([color=BLUE]sin[/color] ([color=BLUE]-[/color] ([color=BLUE]angle[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]caddr[/color] lst)) ([color=BLUE]angle[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]cadr[/color] lst)))))
                           ([color=BLUE]setq[/color] lst ([color=BLUE]vl-list*[/color] ([color=BLUE]cadr[/color] lst) ([color=BLUE]car[/color] lst) ([color=BLUE]cddr[/color] lst)))
                       )
                       ([color=BLUE]if[/color] ([color=BLUE]entmake[/color]
                               ([color=BLUE]list[/color]
                                  '(000 . [color=MAROON]"INSERT"[/color])
                                   ([color=BLUE]cons[/color] 002 blk)
                                   ([color=BLUE]cons[/color] 010 ([color=BLUE]car[/color]  lst))
                                   ([color=BLUE]cons[/color] 041 ([color=BLUE]car[/color]  scl))
                                   ([color=BLUE]cons[/color] 042 ([color=BLUE]cadr[/color] scl))
                                   ([color=BLUE]cons[/color] 050 ([color=BLUE]angle[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]cadr[/color] lst)))
                               )
                           )
                           ([color=BLUE]entdel[/color] ([color=BLUE]ssname[/color] sel idx))
                       )
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

 

Demo:

 

when I tried it, I got an error like this:

Command: ; error: extra cdrs in dotted pair on input

 

what happened? is there an error when I try it?

Edited June 9 by Kvlar

[Lee Mac]

The update to the forum software a few years ago unfortunately corrupted many of the code posts; I have now corrected my earlier post.