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)
)
Solved! Go to Solution.
Solved by phanaem. Go to Solution.
(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) ) ) )
i tried it the way you suggested, but then i get following error:
Redefining block "SBblock"
; error: bad DXF group: (2)
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
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
Many thanks studiemegaton, I'm glad it helps
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
I see - thanks Brandon.