Quantcast
Channel: Autodesk AutoCAD forums
Viewing all articles
Browse latest Browse all 14319

Grading Lisp stops functioning on older dwg after download of 2012 VBA Enabler

$
0
0

I have two CAD files attached and lisp below to calc and insert grading bubble between to existing grading bubbles.

One drawing inserts a bubble with a blank elevation, the other drawing works.

 

I don't know if it's related to when I was getting the VBA - .Net message which I don't get on all my drawings.

I was not using Civil3d for the older drawing.

 

Try running lisp below and grade between bubbles.

 

Is there anyway to get the non function drawing working again.

I've tried to export, copy paste to a new drawing but this condition follows the imported CAD.

 

Any help would be appreciated.

 

/Chris Peterson

 

How can I attached CAD files of these grading bubbles?

 

 

=======================

 

(defun c:grd (/ x1 e1 d e2 p1 p2 enamelist ) (setq p1 ()) (setq p2 ()) (setq edif ()) (setq xdif ()) (setq xlist ()) (setq plist ()) (setq xratio ()) (setq start ()) (setq sxy ()) (setq sx ()) (setq sy ()) (setq e ()) (setq bxy nil) (setq bx nil) (setq by nil) (setq e1 nil) (setq ex nil) (setq ey nil) (setq exy nil) (setq wholedistdiff nil) (setq interpdistdiff nil) (setq interpratio nil) ;(setq enamelist (append enamelist (list (car e1)))) ;(setq p1 (list (atof (cdr (assoc 1 (entget (entnext (car e1)))))))) ;(setq plist (append plist p1)) ;(setq enamelist (append enamelist (list (car e1))))

(setq e1 (entsel "\n Select first Block: ")) ;- Let the user select 1st block (setq bx (cons (cadr (assoc 10 (entget (car e1))))'() ) )   ;(setq sx (cons (car start)'() ) ) (setq by (cons (caddr (assoc 10 (entget (car e1))))'() ) )         ;(setq sy (cons (cadr start) '())) (setq bxy nil) (setq bxy (append bxy bx by)) (setq p1 (list (atof (cdr (assoc 1 (entget (entnext (car e1)))))))) (setq x1 (cons (cadr (assoc 10 (entget (car e1))))'() ) )  ;(list (cadr (assoc 10 (entget (entnext (car e1))))))) (setq plist (append plist p1)) (setq xlist (append xlist x1)) (setq e nil)

(setq e1 (entsel "\n Select select second Block: ")) ;- Let the user select 2nd block (setq ex (cons (cadr (assoc 10 (entget (car e1))))'() ) )   ;(setq sx (cons (car start)'() ) ) (setq ey (cons (caddr (assoc 10 (entget (car e1))))'() ) )         ;(setq sy (cons (cadr start) '())) (setq exy nil) (setq exy (append exy ex ey)) (setq p1 (list (atof (cdr (assoc 1 (entget (entnext (car e1)))))))) (setq x1 (cons (cadr (assoc 10 (entget (car e1))))'() ) )  ;(list (cadr (assoc 10 (entget (entnext (car e1))))))) (setq plist (append plist p1)) (setq xlist (append xlist x1)) (setq edif (abs (- (car plist) (cadr plist)))) (setq xdif (abs (- (car xlist) (cadr xlist)))) (setq wholedistdiff (distance bxy exy))

(command "line" bxy exy "")

(setq os (getvar "osmode")) (setvar "osmode" 512)

(setq start (getpoint "\n  Pick an approximate point for the Interpolation")) (command "erase" "last" "" "") (setq sxy nil) (setq sx nil) (setq sy nil) (setq sx (cons (car start)'())) (setq sy (cons (cadr start) '())) (setq sxy (append sxy sx sy))

(setq interpdistdiff (distance bxy sxy)) (setq interpratio (/ interpdistdiff wholedistdiff))

(setq xratio (abs (/ (-(car start)(car xlist)) xdif  ) ) )

;------Insert Block--------- (command "insert" "gr" sxy "" "" ""  (rtos   (if (> (car plist) (cadr plist))    (- (car plist) (* (abs (- (car plist) (cadr plist))) interpratio))    (+ (car plist) (* (abs (- (car plist) (cadr plist))) interpratio))                 )  ;end if     2 zdigit ) ; end rtos "99999" "interp")

(setvar "osmode" os)

) ; end defun


Viewing all articles
Browse latest Browse all 14319

Trending Articles