Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Lisp routine required to replace/place a block on each closed polyline?

13 REPLIES 13
Reply
Message 1 of 14
Serichy76
2126 Views, 13 Replies

Lisp routine required to replace/place a block on each closed polyline?

Does anyone know if there is a Lisp routine available to batch replace all the closed polylines with an existing block? Any help would be gratefully received...  : )

13 REPLIES 13
Message 2 of 14
pbejse
in reply to: Serichy76


@Serichy76 wrote:

Does anyone know if there is a Lisp routine available to batch replace all the closed polylines with an existing block? Any help would be gratefully received...  : )


Yup. you could try searching the forum first. if you can't find one, THEN we'll make one.

 


 

Message 3 of 14
stevor
in reply to: Serichy76

If not, there will be.

 

What about the posibility of diffeent sizes, and orientations?

And one usually includes layer data.

S
Message 4 of 14
pbejse
in reply to: stevor


@stevor wrote:

If not, there will be.

 



Indeed Smiley LOL

 

 

Message 5 of 14
Serichy76
in reply to: pbejse

I did have an extensive search first before posting this message but no luck  : (

basically I have a number of different closed plines, some shaped into triangles for example. I need to place an existing block in the centre of each triangle, it really doesn't matter which way the triangle faces & the blocks can all be placed the same orientation, it's for location more than anything.

 

Many thanks for your time

 

Sally

Message 6 of 14
pbejse
in reply to: pbejse

Here's a starting point for you.

 

(defun Pl2oBlock (bn / *error* _Center old_os ss i)
  (vl-load-com)
  (defun *error* (msg)
    (command "._undo" "_end")
    (setvar 'osmode old_os)
    (setvar 'cmdecho 1)
  ) ;_ end_defun
  (defun _Center (e / mn mx)
    (vla-getboundingbox (vlax-ename->vla-object e) 'mn 'mx)
    (mapcar (function (lambda (a b) (/ (+ a b) 2.)))
	    (vlax-safearray->list mn)
	    (vlax-safearray->list mx)
    )
  )
  (setq old_os (getvar 'osmode))
  (setvar 'osmode 0)
  (command "._undo" "_begin")
  (if (and (tblsearch "BLOCK" bn)
	   (setq ss (ssget "_X"
			   '((0 . "LWPOLYLINE")
			     (-4 . "&=")
			     (70 . 1)
			     (410 . "MODEL")
			    )
		    )
	   )
      )
    (repeat (setq i (sslength ss))
      (vlax-invoke
	(vlax-get (vla-get-ActiveLayout
		    (vla-get-activedocument (vlax-get-acad-object))
		  )
		  'Block
	)
	'InsertBlock
	(_Center (ssname ss (setq i (1- i))))
	bn 1 1 1 0
      )
    )
  )
  (*error* "")
  (princ)
)

 

(PL2OBLOCK "BlockName")

 

HTH

 

Message 7 of 14
Serichy76
in reply to: pbejse

My apologies but I can't seem to get this to work, I've pasted the routine into a lisp file then APPLOAD into AutoCAD but the promt PL2oBlock isn't being recognised.

 

last week I did find a lisp to replace circles with blocks which works brilliantly (see attached). it works by having the desired block already on the page so the promt asks for the block first which u select, then asks you to select which circles to replace. Is there a way this could be modified to work with triangles?

 

Thank you so much for this.

Message 8 of 14
Kent1Cooper
in reply to: Serichy76


@Serichy76 wrote:

I did have an extensive search first before posting this message but no luck  : (

basically I have a number of different closed plines, some shaped into triangles for example. I need to place an existing block in the centre of each triangle, it really doesn't matter which way the triangle faces & the blocks can all be placed the same orientation, it's for location more than anything.

 

Many thanks for your time

 

Sally


Here's my take on it [without some of the controls you could add, such as Object-Snap, error handling, etc.]:

 

(setq CPss
  (ssget "_X"
    '( ; find all Closed LWPolylines
      (-4 . "<and")
        (0 . "LWPOLYLINE")
        (-4 . "<or"); closed
          (70 . 1); without linetype generation
          (70 . 129); with linetype generation
        (-4 . "or>")
      (-4 . "and>")
    ); filter list
  ); ssget
); setq
(foreach pl (mapcar 'cadr (ssnamex CPss)); list of entity names
  (setq
    pldata (entget pl); entity data
    verts (cdr (assoc 90 pldata)); number of vertices
    verlist ; list of vertices
      (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata))
    sum '(0 0); reset for each
  ); setq
  (foreach x verlist (setq sum (mapcar '+ x sum))); sum of X,Y of all vertices
  (command
    "_.insert"
    "YourBlockName" ; <---------------------- EDIT THIS
    (mapcar '/ sum (list verts verts)); average of vertex locations
    "" "" "" ; scales = 1, rotation = 0
  ); command
); foreach

Kent Cooper, AIA
Message 9 of 14
pbejse
in reply to: Serichy76


@Serichy76 wrote:

My apologies but I can't seem to get this to work, I've pasted the routine into a lisp file then APPLOAD into AutoCAD but the promt PL2oBlock isn't being recognised.

 

Thank you so much for this.


The usage

(Pl2oBlock "Blockname")

 

I made it that way so the blcok name would be generic, as prepration for you script in the event that the drawing requries a different block for every opened drawing

 

_.open "C:\Folderpath\sample1.dwg" (Pl2oBlock "Blockname") _.save  _close
_.open "C:\Folderpath\sample2.dwg" (Pl2oBlock "Blockname") _.save  _close

  


@Serichy76 wrote:

 

last week I did find a lisp to replace circles with blocks which works brilliantly (see attached). it works by having the desired block already on the page so the promt asks for the block first which u select, then asks you to select which circles to replace. Is there a way this could be modified to work with triangles?

 


As for that one , well.... you can check the authors website  LeeMac , knowing LM he probably have an updated version for that routien you attached.

 

HTH

 

 

 

Message 10 of 14
pbejse
in reply to: Kent1Cooper


@Kent1Cooper wrote:

 

  (foreach x verlist (setq sum (mapcar '+ x sum))); sum of X,Y of all vertices
  (command
    "_.insert"
    "YourBlockName" ; <---------------------- EDIT THIS
    (mapcar '/ sum (list verts verts)); average of vertex locations
    "" "" "" ; scales = 1, rotation = 0
  ); command
); foreach


Nice Kent. Smiley Happy

 

 

Message 11 of 14
Kent1Cooper
in reply to: pbejse


@pbejse wrote:

@Kent1Cooper wrote:

 

  (foreach x verlist (setq sum (mapcar '+ x sum))); sum of X,Y of all vertices
  (command
    "_.insert"
    "YourBlockName" ; <---------------------- EDIT THIS
    (mapcar '/ sum (list verts verts)); average of vertex locations
    "" "" "" ; scales = 1, rotation = 0
  ); command
....


Nice Kent.

Thanks.  The advantage of doing it by averaging the vertex locations, as compared to finding the center of the bounding box, is that it gets the "center of gravity" of the Polyline.  Under some circumstances, that's more likely to "look" like the middle.  For example, on a right triangle with orthogonal legs, the center of the bounding box will be on an edge [at the midpoint of the hypotenuse], whereas the average of the vertex locations will be inside the triangle.  That distinction may not matter very much to the current question, but sometimes it can.

 

And thanks for using the "&=" operator in a relational test, which I hadn't tried before.  [I find that in this case, the plain "&" operator also works, and I need to study up on those to understand what they're doing, because at first I thought the description suggested that the "&=" operator would not find those with linetype generation on, but it does.]

Kent Cooper, AIA
Message 12 of 14
pbejse
in reply to: Kent1Cooper


Kent1Cooper wrote:


 

Thanks.  The advantage of doing it by averaging the vertex locations, as compared to finding the center of the bounding box, is that it gets the "center of gravity" of the Polyline.  Under some circumstances, that's more likely to "look" like the middle.  ........

 

And thanks for using the "&=" operator in a relational test, which I hadn't tried before.  [I find that in this case, the plain "&" operator also works, and I need to study up on those to understand what they're doing, because at first I thought the description suggested that the "&=" operator would not find those with linetype generation on, but it does.]


Cool beans.

 

Keep us posted regarding Relational Tests, there are times that it confuses the heck out of me too.

 

Cheers

Message 13 of 14
nmritten
in reply to: pbejse


Hi guys,

I know this is an old post, but I would like some help.

 

I need a LISP that replaces closed polylines with a block. I used the routines you posted and got it to work exactly once and can't get it to work again. I'd appreciate it if you could take a look and help me out by posting the correct lisp.

 

I've attached my dwg file. It is an exploded braille font of closed polylines. I need each dot replaced by a 3d sphere block "BRAILLE".

 

Thanks,

Nikki

 

 

Message 14 of 14
nmritten
in reply to: nmritten

ok, I  finally got it to work using a different lisp. This one places a block at then endpoint of a polyline, but that works for me. It is from this post:

http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Adding-a-block-to-the-ends-of-a-polyl...

 

Here is the code:

(defun c:BAE ( / *error* _StartUndo _EndUndo _Insert _AngleAtParam doc block ss )
 
(command "_.insert")
(command);cancel insert
(vl-load-com)
  (setq block "braille.dwg") ;; << Block Name
  (defun *error* ( msg )
    (and doc (_EndUndo doc))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ)
  )
  (defun _StartUndo ( doc ) (_EndUndo doc)
    (vla-StartUndoMark doc)
  )
  (defun _EndUndo ( doc )
    (if (= 8 (logand 8 (getvar 'UNDOCTL)))
      (vla-EndUndoMark doc)
    )
  )
  (defun _Insert ( block point rotation )
    (entmakex
      (list
        (cons 0 "INSERT")
        (cons 2  block)
        (cons 10 point)
        (cons 50 rotation)
      )
    )
  )
  (defun _AngleatParam ( entity param )
    (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv entity param))
  )      
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (cond
    ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
      (princ "\n** Current Layer Locked **")
    )
    ( (not
        (or
          (and (tblsearch "BLOCK" (vl-filename-base block))
            (setq block (vl-filename-base block))
          )
          (and
            (setq block
              (findfile
                (strcat block
                  (if (eq "" (vl-filename-extension block)) ".dwg" "")
                )
              )
            )
            (
              (lambda ( / ocm )
                (setq ocm (getvar 'CMDECHO)) (setvar 'CMDECHO 0)
                (command "_.-insert" block) (command)
                (setvar 'CMDECHO ocm)
               
                (tblsearch "BLOCK" (setq block (vl-filename-base block)))
              )
            )
          )
        )
      )
      (princ "\n** Block not Found **")
    )
    ( (not (setq ss (ssget '((0 . "*POLYLINE")))))
      (princ "\n*Cancel*")
    )
    (t
      (_StartUndo doc)
    
      (
        (lambda ( i / e )
          (while (setq e (ssname ss (setq i (1+ i))))
            (foreach param (list (vlax-curve-getStartParam e) (vlax-curve-getEndParam e))
              (_Insert block (vlax-curve-getPointatParam e param) (_AngleAtParam e param))            
            )
          )
        )
        -1
      )
      (_EndUndo doc)
    )
  )
  (princ)
)

 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost