Insert block at intersection

[studiemegaton]

I tried to addapt the code provided by scottbolton in the "Insert block at intersection" thread to suit my needs.

i would like to be able to enter a blockname, and let that block be inserted at intersection points.

But i keep getting a DXF error.

A hand from the lisp gurus might help.

(defun c:sbx (/)
  (vl-load-com)
;;;define block used in program
  (setq bloktype (getvar "USERS5"))
  (prompt "\basiswaarde: ")
  (princ bloktype)
  (setq    bloktypenieuw
     (getstring (strcat "\ngeef type : <"
                (getvar "users5")
                ">: "
            )
     )
  )
  (princ "\type: ")
  (princ bloktypenieuw)
  (if (= bloktypenieuw "")
    (setq bloktypenieuw bloktype)
  )
  (princ "\noutput type na if: ")
  (princ bloktypenieuw)
  (if (/= bloktypenieuw kokertype)
    (setvar "USERS5" bloktypenieuw)
  )

;;; actual code
  (progn
    (setq ent (car (entsel "\nSelect main line: ")))
    (if    ent
      (progn
    (princ "\nSelect crossing line(s): ")
    (if (setq ss (ssget))
      (progn
        (setq count        0
          obj        (vlax-ename->vla-object ent)
          pointlist nil
        )
        (repeat (sslength ss)
          (setq xent (ssname ss count)
            xobj (vlax-ename->vla-object xent)
          )
          (if (setq int (vla-IntersectWith obj xobj acExtendNone))
        (progn
          (setq    int      (vlax-safearray->list (vlax-variant-value int))
            pointlist (append pointlist (list int))
          )
        )
          )
          (setq count (1+ count))
        )
        (if    (null (tblobjname "BLOCK" "SBblockSBblock"))
          (progn
        (entmake (list (cons 0 "BLOCK")
                   (cons 2 "SBblock")
                   (cons 70 0)
                   (list 10 0.0 0.0 0.0)
             )
        )
        (entmake '((0 . "LWPOLYLINE")
               (100 . "AcDbEntity")
               (8 . "0")
               (100 . "AcDbPolyline")
               (90 . 2)
               (70 . 1)
               (43 . 1.0)
               (38 . 0.0)
               (39 . 0.0)
               (10 2.5 0.0)
               (40 . 1.0)
               (41 . 1.0)
               (42 . 1.0)
               (91 . 0)
               (10 -2.5 0.0)
               (40 . 1.0)
               (41 . 1.0)
               (42 . 1.0)
               (91 . 0)
               (210 0.0 0.0 1.0)
              )
        )
        (setq blockname (entmake '((0 . "ENDBLK"))))
          )
        )
        (foreach pt_nth pointlist
          (entmake (append
             '((0 . "INSERT")
               (100 . "AcDbEntity")
               (8 . "0")
               (100 . "AcDbBlockReference")
;;;            start of problem area
               (cons 2 blocktype)

;;;          end of area
              )
             (list (cons 10 pt_nth))
             '((41 . 1.0)
               (42 . 1.0)
               (43 . 1.0)
               (50 . 0.0)
               (70 . 0)
               (71 . 0)
               (44 . 0.0)
               (45 . 0.0)
               (210 0.0 0.0 1.0)
              )
               )
          )
        )
      )
    )
      )
    )
  )
  (princ)
)

[phanaem]

(cons 2 ... is not evaluated inside quoted list.

Try this

(entmake (append
             '((0 . "INSERT")
               (100 . "AcDbEntity")
               (8 . "0")
               (100 . "AcDbBlockReference")
;;;            start of problem area
;;;               (cons 2 blocktype)
;;;          end of area
              )
             (list (cons 2 blocktype)  (cons 10 pt_nth))
             '((41 . 1.0)
               (42 . 1.0)
               (43 . 1.0)
               (50 . 0.0)
               (70 . 0)
               (71 . 0)
               (44 . 0.0)
               (45 . 0.0)
               (210 0.0 0.0 1.0)
              )
               )
          )

[studiemegaton]

i tried it the way you suggested, but then i get following error:

Redefining block "SBblock"
; error: bad DXF group: (2)

[phanaem · Accepted solution]

Looks like blocktype variable is nil.

At the begining of your code, it is spelled bloktype.

Also, you have a not initialized variable - kokertype

and one set, but not used - blockname

[studiemegaton]

thank you very much. this slight oversight has taken me a lot of time trying to figure it out.

[Lee_Mac]

Here is an old program of mine:

;;------------=={ Insert Block at Intersections }==-----------;;
;;                                                            ;;
;;  Prompts the user to select or specify a block to be       ;;
;;  inserted, and make a selection of intersecting objects.   ;;
;;  Proceeds to insert the specified block at all points of   ;;
;;  intersection between all objects in the selection.        ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:ib ( / *error* a b bfn blk cmd i j sel spc )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (while
        (progn
            (setvar 'errno 0)
            (initget "Name Browse Exit")
            (setq sel (entsel "\nSelect block to insert [Name/Browse] <Exit>: "))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (or (null sel) (= "Exit" sel))
                    nil
                )
                (   (= "Browse" sel)
                    (if (setq bfn (getfiled "Select Block" (getvar 'dwgprefix) "dwg" 16))
                        (if (null (tblsearch "block" (setq blk (cadr (fnsplitl bfn)))))
                            (progn
                                (setq cmd (getvar 'cmdecho))
                                (setvar 'cmdecho 0)
                                (command "_.-insert" bfn nil)
                                (setvar 'cmdecho cmd)
                                (null (tblsearch "block" blk))
                            )
                        )
                        (princ "\n*Cancel*")
                    )
                )
                (   (= "Name" sel)
                    (while
                        (not
                            (or (= "" (setq blk (getstring t "\nSpecify block name <Select>: ")))
                                (tblsearch "block" blk)
                            )
                        )
                        (princ "\nBlock not found.")
                    )
                    (= "" blk)
                )
                (   (= 'list (type sel))
                    (if (= "INSERT" (cdr (assoc 0 (entget (car sel)))))
                        (setq blk (LM:blockname (vlax-ename->vla-object (car sel))))
                        (princ "\nObject is not a block.")
                    )
                )
            )
        )
    )

    (if
        (and
            (= 'str (type blk))
            (tblsearch "block" blk)
            (setq sel (ssget))
        )
        (progn
            (setq spc
                (vlax-get-property (LM:acdoc)
                    (if (= 1 (getvar 'cvport))
                        'paperspace
                        'modelspace
                    )
                )
            )
            (LM:startundo (LM:acdoc))
            (repeat (setq i (sslength sel))
                (setq a (vlax-ename->vla-object (ssname sel (setq i (1- i)))))
                (if (vlax-method-applicable-p a 'intersectwith)
                    (repeat (setq j i)
                        (setq b (vlax-ename->vla-object (ssname sel (setq j (1- j)))))
                        (if (vlax-method-applicable-p b 'intersectwith)
                            (foreach p (LM:intersections a b acextendnone)
                                (vla-insertblock spc (vlax-3D-point p) blk 1.0 1.0 1.0 0.0)
                            )
                        )
                    )
                )
            )
            (LM:endundo (LM:acdoc))
        )
    )
    (princ)
)

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; obj1,obj2 - VLA-Objects with the intersectwith method applicable
;; mode      - acextendoption enum of intersectwith method

(defun LM:intersections ( obj1 obj2 mode / l r )
    (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
    (repeat (/ (length l) 3)
        (setq r (cons (list (car l) (cadr l) (caddr l)) r)
              l (cdddr l)
        )
    )
    (reverse r)
)

;; Block Name  -  Lee Mac
;; Returns the true (effective) name of a supplied block reference
                        
(defun LM:blockname ( obj )
    (if (vlax-property-available-p obj 'effectivename)
        (defun LM:blockname ( obj ) (vla-get-effectivename obj))
        (defun LM:blockname ( obj ) (vla-get-name obj))
    )
    (LM:blockname obj)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com) (princ)

P.S. How do you attach a LISP file on this forum?
I keep receiving a message: 'The contents of the attachment doesn't match its file type.'

Lee

[studiemegaton]

works like a charm as always. i should have taken a look at your lisp routines before trying to build one.

[Lee_Mac]

Many thanks studiemegaton, I'm glad it helps

[bhull1985]

I remember reading a post from an autodesk guy stating that they were working on a hotfix to enable .lsp and .dcl files.

I think they would just need to be renamed to the .txt extension in the meantime

[Lee_Mac]

I see - thanks Brandon.