Author Topic: Block insert on points  (Read 2130 times)

0 Members and 1 Guest are viewing this topic.

ronjonp

  • Needs a day job
  • Posts: 7529
Block insert on points
« on: November 18, 2005, 03:20:59 PM »
So I have a bunch of points in a drawing on about 10 different layers and I want to insert a certain block at each point. The blockname that is inserted corresponds to the layer the point is on. I have the code below that I could duplicate 10 times and it would work but I was wondering what are the different ways to grab all the layers in the drawing in a list and evaluate with selection sets of point objects?


Code: [Select]
(defun c:symbols (/ path ss index obj pt)

(command "._undo" "_begin")

(setq path "C:/GPS_SYM/")

(if (setq ss (ssget "x" '((0 . "POINT")(8 . "FULL_CIRCLE"))))
     (progn
       (setq index -1)
       (while (< (setq index (1+ index)) (sslength ss))
(setq obj  (ssname ss index)
               obj  (vlax-ename->vla-object obj)
       pt   (vlax-get obj 'coordinates)
)
(vl-cmdf "_-insert" (strcat path "FULL_CIRCLE.dwg") pt "" "" "")
       )
     )
   )
(command "._undo" "_end")
)

Thanks,

Ron

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Jeff_M

  • King Gator
  • Posts: 4096
  • C3D user & customizer
Re: Block insert on points
« Reply #1 on: November 18, 2005, 03:33:23 PM »
Hi Ron,
You can try this, I have not tested it but I believe it will work.....providing the block/layer names match as you described.
Code: [Select]
(defun c:symbols (/ path ss index obj pt layname lay)
  (command "._undo" "_begin")
  (setq path "C:/GPS_SYM/")
  (while (setq lay (tblnext "layer" (not lay)))
    (setq layname (cdr (assoc 2 lay)))
    (if (setq ss (ssget "x" (list '(0 . "POINT") (cons 8 layname))))
      (progn
(setq index -1)
(while (< (setq index (1+ index)) (sslength ss))
  (setq obj (ssname ss index)
obj (vlax-ename->vla-object obj)
pt  (vlax-get obj 'coordinates)
  )
  (if (tblsearch "block" layname)
    (vl-cmdf "_-insert" layname pt "" "" "")
    (vl-cmdf "_-insert"
     (strcat path layname ".dwg")
     pt
     ""
     ""
     ""
    )
  )
)
      )
    )
  )
  (command "._undo" "_end")
)

ronjonp

  • Needs a day job
  • Posts: 7529
Re: Block insert on points
« Reply #2 on: November 18, 2005, 03:50:24 PM »
Thanks Jeff. Exactly what I was looking for.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

ronjonp

  • Needs a day job
  • Posts: 7529
Re: Block insert on points
« Reply #3 on: June 06, 2006, 05:55:26 PM »
Here is the code I spawned from Jeff's example above if anyone is interested.

Code: [Select]
(defun c:symbols (/ scl path ss index obj pt layname lay fn AGGH)
  (defun UndoBegin ()
    (vla-EndUndoMark
      (vla-Get-ActiveDocument
(vlax-Get-Acad-Object)
      )
    )
    (vla-StartUndoMark
      (vla-Get-ActiveDocument
(vlax-Get-Acad-Object)
      )
    )
    (princ (strcat "\n Undo begin set " (getvar 'dwgname)))
    (princ)
  )

  (defun UndoEnd ()
    (vla-EndUndoMark
      (vla-Get-ActiveDocument
(vlax-Get-Acad-Object)
      )
    )
    (princ (strcat "\n Undo end set " (getvar 'dwgname)))
    (princ)
  )
  (UndoBegin)
  (setq scl (getreal "\n Enter drawing scale: "))
  (setq path
(getfiled "Where are your blocks?"
   (getvar 'dwgprefix)
   "dwg"
   8
)
  )
  (if (wcmatch path "*:*")
    (setq path (strcat (vl-filename-directory path) "\\"))
    (setq path (getvar 'dwgprefix))
  )
  (if (ssget "x" '((0 . "POINT")))
    (progn
      (while (setq lay (tblnext "layer" (not lay)))
(setq layname (cdr (assoc 2 lay)))
(if
  (setq ss (ssget "x" (list '(0 . "POINT") (cons 8 layname))))
   (progn
     (setq index -1)
     (while (< (setq index (1+ index)) (sslength ss))
       (setq obj (vlax-ename->vla-object (ssname ss index))
     pt (trans (vlax-get obj 'coordinates) 0 1)
       )
       (vl-cmdf "_-layer" "_make" layname "")
       (if (tblsearch "block" layname)
(vl-cmdf "_-insert" layname pt scl scl "")
(if (findfile (strcat path layname ".dwg"))
   (vl-cmdf "_-insert"
    (strcat path layname ".dwg")
    pt
    scl
    scl
    ""
   )
   (progn
     (setq AGGH 1)
     (setq fn (open (strcat (getvar "dwgprefix")
    "symbols_not_inserted.txt"
    )
    "a"
      )
     )
     (write-line
       (strcat path
       layname
       ".dwg - not found and ignored!"
       )
       fn
     )
     (close fn)
   )
)
       )
       (princ (strcat (itoa index) " " layname " inserted."))
     )
   )
)
      )
    )
    (alert "No Points Found in Drawing to Replace with Blocks!!"
    )
  )
  (UndoEnd)
  (if (= AGGH 1)
    (alert (strcat "\nSOME BLOCKS NOT FOUND FOR POINTS!"
   "\n-----------------------------------"
   "\nREFER TO - "
   (getvar "dwgprefix")
   "symbols_not_inserted.txt"
   )
    )
    (alert "\nALL POINTS SUCCESSFULLY SWAPPED!")
  )
)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC