Attached is a command the one and only Lee Mac created about 10 years ago for me. (Paid for, even though he insisted on not taking $). I've recently reinstalled on a 2016 version and am getting an error thaqt I've never received with the same lisp on other machines. Is there a variable I can change to fix? Command has always been command-s. But I continue to get Specify Next Point: VVC: Internal Error
Thank you for any help guys!
;; Example Command creation:
(defun c:dbl nil (dbl "d4cj@12"))
;; Example Macro creation:
;; ^C^C(dbl "d4cj@12")
;;----------------------------------------------------------------------------------------------;;
;; Sub function - call with blockname, blockname.dwg or C:\\My Folder\\blockname.dwg ;;
;;----------------------------------------------------------------------------------------------;;
(defun dbl ( block / *error* _StartUndo _EndUndo _Mid doc vl ov b p1 p2 )
(vl-load-com)
;; © Lee Mac 2010
(defun *error* ( msg )
(if ov (mapcar 'setvar vl ov))
(if 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 _Mid ( a b ) (mapcar '(lambda ( a b ) (/ (+ a b) 2.)) a b))
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq vl '("CMDECHO") ov (mapcar 'getvar vl))
(cond
(
(not (setq b (LM:ForceBlockDefinition block)))
(princ (strcat "\n** " (vl-filename-base block) " block not Found **"))
)
(
(= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
(princ "\n** Current Layer Locked **")
)
(
(not
(and
(setq p1 (getpoint "\nSpecify First Point: "))
(setq p2 (getpoint "\nSpecify Next Point: " p1))
)
)
)
(t
(_StartUndo doc)
(mapcar 'setvar vl '(0))
(mapcar
(function
(lambda ( a b ) (vl-cmdf "_.leader" "_non" a "_non" b "" "" "_none"))
)
(list p1 p2) (list p2 p1)
)
(mapcar 'set '(p1 p2) (mapcar '(lambda ( x ) (trans x 1 0)) (list p1 p2)))
(if
(setq bEnt
(entmakex
(list
(cons 0 "INSERT")
(cons 2 b)
(cons 10 (_Mid p1 p2))
(cons 50 (LM:MakeReadable (angle p1 p2)))
)
)
)
(progn
(vla-explode (vlax-ename->vla-object bEnt))
(entdel bEnt)
)
)
(mapcar 'setvar vl ov)
(_EndUndo doc)
)
)
(princ)
)
;;---------------=={ Force Block Definition }==---------------;;
;; ;;
;; Ensures, if possible, that a block definition is present ;;
;; in a drawing. ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, June 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; block - block name or filename ;;
;;------------------------------------------------------------;;
;; Returns: Block name, else nil ;;
;;------------------------------------------------------------;;
(defun LM:ForceBlockDefinition ( block / path ext base )
;; © Lee Mac 2010
(setq path (vl-filename-directory block)
ext (vl-filename-extension block)
base (vl-filename-base block))
(or ext (setq ext ".dwg"))
(or (eq "" path) (setq path (strcat path "\\")))
(cond
( (tblsearch "BLOCK" base) base )
( (setq block (findfile (strcat path base ext)))
(command-s "_.-insert" block) (command-s) base
)
)
)
;;-------------------=={ Make Readable }==--------------------;;
;; ;;
;; Returns an angle corrected for text readability ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; a - angle to process ;;
;;------------------------------------------------------------;;
;; Returns: angle corrected for text readability ;;
;;------------------------------------------------------------;;
(defun LM:MakeReadable ( a )
;; © Lee Mac 2010
(
(lambda ( a )
(cond
(
(and (> a (/ pi 2)) (<= a pi))
(- a pi)
)
(
(and (> a pi) (<= a (/ (* 3 pi) 2)))
(+ a pi)
)
(
a
)
)
)
(rem a (* 2 pi))
)
)
(defun c:dbl nil (dbl "D4CJ@12.dwg"))
(defun c:dbl nil (dbl "D4CJ@16.dwg"))
(defun c:dbl nil (dbl "D6CJ@12.dwg"))
(defun c:dbl nil (dbl "D6CJ@16.dwg"))
(defun c:dbl nil (dbl "D8CJ@12.dwg"))
(defun c:dbl nil (dbl "D8CJ@16.dwg"))
(defun c:dbl nil (dbl "D8FJ@12.dwg"))
(defun c:dbl nil (dbl "D8FJ@16 TRTD.dwg"))
(defun c:dbl nil (dbl "D8FJ@16.dwg"))
(defun c:dbl nil (dbl "D10CJ@12.dwg"))
(defun c:dbl nil (dbl "D10CJ@16.dwg"))
(defun c:dbl nil (dbl "D10FJ@16 TRTD.dwg"))
(defun c:dbl nil (dbl "D10FJ@16 TYP.dwg"))
(defun c:dbl nil (dbl "D10FJ@16.dwg"))
