Convert block to point

I have layout of pile.I ask how convert block to point ( block is pile)??

block.dwg

And just what would be the purpose of this? Wouldn't you like to assign some attributes to your block? Substituting a point for a block would not allow you to do this. Just thinking ahead.

Perhaps the simplest way to just convert the block to a point, would be to redefine the block as a point.

Just quickly:

(defun c:blk2pt (/ doc spc ss)
 (vl-load-com)
 (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)))  
 (if (setq ss (ssget '((0 . "INSERT"))))
   (progn
     (mapcar
       (function
         (lambda (x)
           (vla-addPoint spc
             (vlax-3D-point x))))
       (mapcar
         (function
           (lambda (x)
             (cdr (assoc 10 (entget x)))))
         (vl-remove-if 'listp
           (mapcar 'cadr (ssnamex ss)))))
     (command "_.erase" ss "")))
 (princ))

But, out of interest, is this so that you can use the LISP I posted in this thread?

http://www.cadtutor.net/forum/showthread.php?t=37762

Lee

Or something like this:

[b][color=BLACK]([/color][/b]defun c:ins2poi [b][color=FUCHSIA]([/color][/b]/ ss i en ed nd[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]not ss[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]princ [color=#2f4f4f]"\nSelect INSERTs To Convert To POINTs..."[/color][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=BLUE])[/color][/b]
                              [b][color=BLUE]([/color][/b]if [b][color=RED]([/color][/b]getvar [color=#2f4f4f]"CTAB"[/color][b][color=RED])[/color][/b]
                                  [b][color=RED]([/color][/b]cons 410 [b][color=PURPLE]([/color][/b]getvar [color=#2f4f4f]"CTAB"[/color][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
                                  [b][color=RED]([/color][/b]cons 67 [b][color=PURPLE]([/color][/b]- 1 [b][color=TEAL]([/color][/b]getvar [color=#2f4f4f]"TILEMODE"[/color][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq i [b][color=NAVY]([/color][/b]sslength ss[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]not [b][color=MAROON]([/color][/b]minusp [b][color=GREEN]([/color][/b]setq i [b][color=BLUE]([/color][/b]1- i[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq en [b][color=MAROON]([/color][/b]ssname ss i[b][color=MAROON])[/color][/b]
              ed [b][color=MAROON]([/color][/b]entget en[b][color=MAROON])[/color][/b]
              nd [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 10 [b][color=BLUE]([/color][/b]trans [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 10 ed[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] en 0[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                       [b][color=GREEN]([/color][/b]cons 0  [color=#2f4f4f]"POINT"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]foreach g '[b][color=MAROON]([/color][/b]6 8 39 48 62 210[b][color=MAROON])[/color][/b]
           [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]assoc g ed[b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]setq nd [b][color=BLUE]([/color][/b]cons [b][color=RED]([/color][/b]cons g [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc g ed[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] nd[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]entdel en[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]reverse nd[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]redraw[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

-David

I knew you'd approach it like that David - I considered doing it like that too, but it seemed too much trouble

Lee,

To be honest, I don't see where the vl approach is any better or easier to read / comprehend. It's just more typing and chances for typos My $0.02. -David

To be honest, I don't see where the vl approach is any better or easier to read / comprehend. It's just more typing and chances for typos...

I'm not saying that the VL method is any better/worse, but just that when I thought about approaching the problem in that way, I couldn't see a concise way to do it. - but you could.

Just quickly:

 

(defun c:blk2pt (/ doc spc ss)
 (vl-load-com)
 (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)))  
 (if (setq ss (ssget '((0 . "INSERT"))))
   (progn
     (mapcar
       (function
         (lambda (x)
           (vla-addPoint spc
             (vlax-3D-point x))))
       (mapcar
         (function
           (lambda (x)
             (cdr (assoc 10 (entget x)))))
         (vl-remove-if 'listp
           (mapcar 'cadr (ssnamex ss)))))
     (command "_.erase" ss "")))
 (princ))

 

But, out of interest, is this so that you can use the LISP I posted in this thread?

 

http://www.cadtutor.net/forum/showthread.php?t=37762

 

Lee

Lee, just a suggestion... that might prove useful to these folks...

insert the "point" on a layer of its own, don't erase the blocks, leave them as is, and then the can run your ptsort.lsp on the layer containing the new "point(s)" (and retain their original dwg after possibly freezing the newly made layer)

just my 2 cents....

Steve

Thank You..

Just quickly:

 

(defun c:blk2pt (/ doc spc ss)
 (vl-load-com)
 (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)))  
 (if (setq ss (ssget '((0 . "INSERT"))))
   (progn
     (mapcar
       (function
         (lambda (x)
           (vla-addPoint spc
             (vlax-3D-point x))))
       (mapcar
         (function
           (lambda (x)
             (cdr (assoc 10 (entget x)))))
         (vl-remove-if 'listp
           (mapcar 'cadr (ssnamex ss)))))
     (command "_.erase" ss "")))
 (princ))

 

But, out of interest, is this so that you can use the LISP I posted in this thread?

 

http://www.cadtutor.net/forum/showthread.php?t=37762

 

Lee

@Lee and/or others

How can the LISP be upgraded to insert the point on the same layer as the block is/was?

(setq LAYERNAME (vla-get-layer ??))

I wanne try this one myself

44 minutes ago, B.N. said:

@Lee and/or others

How can the LISP be upgraded to insert the point on the same layer as the block is/was?

(setq LAYERNAME (vla-get-layer ??))

 

I wanne try this one myself

 

?? is where you would need to define the entity

If your using the last code posted.

(cdr (assoc 10 (entget x))) is pulling the point

(cdr (assoc 8 (entget x))) would pull the layer.

so maybe. untested.

        (mapcar
          (function
            (lambda (x) (cdr (assoc 10 (entget x))))
            (setvar 'clayer (cdr (assoc 8 (entget x))))
          )

i would just rewrite it like this easier to follow.

(defun c:blk2pt (/ doc spc ss)
  (vl-load-com)
  (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)
        )
  )
  (if (setq ss (ssget '((0 . "INSERT"))))
    (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq pt (cdr (assoc 10 (setq blk (entget blk)))))
      (setvar 'clayer (cdr (assoc 8 blk))) 
      (vla-addPoint spc (vlax-3D-point pt))
    )
  )
  (command "_.erase" ss "")
  (princ)
)