Topic: Surface Elevation LISP -review

[DanB]

I have gotten to a point where I am pleased with the functions of the following code, however, there seems to be some issues with exiting AutoCAD after running the routine. I presume that this is tied to the LDD portion of code (although I could very well be wrong). Can anyone please read through (possibly even test) the code and give me any feedback you may have on why I am crashing AutoCAD.

A couple of things:
-For testing purposes the style of block to be used is simply an attribute (i.e. "Elev") with a rectangle around it, this must be pre-defined in the drawing
-There must be a Surface/TIN in the LDD project (set current)
-When prompted for Centerline, select any location within the Surface

Code: [Select]


(defun C:Addsurf (/ acadObj1 aecApp1 aecProj aecSurfs aecSurf aecUtil pt# e-n selev newelev acadObj2 aecApp2 aecDoc PrefDoc Hscale xsf ysf rta typ ctyp ipt atr emsg elevdif elevc)
 (setq acadObj2  (vlax-get-acad-object))
  (setq aecApp2  (vla-getinterfaceobject acadObj2 "Aecc.Application"))
  (setq aecDoc (vlax-get aecApp2 "ActiveDocument"))
  (setq PrefDoc (vlax-get aecDoc "preferences"))
  (setq Hscale (vlax-get PrefDoc "DatabaseScale"))
   (if (= XSF nil) (setq XSF hscale))
   (if (= YSF nil) (setq YSF xsf))
   (if (= RTA nil) (setq RTA 0.0))
  (if Addsurf:BLK
    (progn
      (setq TYP (strcat "\nBlock to Insert: <" Addsurf:BLK "> "))
      (setq CTYP (getstring TYP))
       (if (= CTYP "")             ;; If user presses Enter
        (setq Addsurf:BLK Addsurf:BLK)             ;;  leave the block the same as it was
        (setq Addsurf:BLK CTYP)            ;; No, a new value was entered, use new value
        )
     )
      (setq Addsurf:BLK (getstring "\nBlock to Insert: "))
   )
;;
;;
  (if chelev
   (progn
    (setq chelev (rtos chelev))
    (setq elevdif (strcat "\nElevation Change: <" chelev "> "))
    (setq chelev (atof
      (if (= (setq elevc (getstring elevdif)) "") chelev elevc
       )
                  )
     )
    )
     (setq chelev (atof (getstring "\nElevation Change: ")))
   )
;;
;;
   (setq acadObj1  (vlax-get-acad-object)
     aecApp1  (vla-getinterfaceobject acadObj1 "Aecc.Application")
     aecProj (vlax-get aecApp1 "Activeproject")    
     aecSurfs (vlax-get aecProj "Surfaces")
     aecSurf (vlax-get aecSurfs "Currentsurface")
     aecUtil (vlax-get (vlax-get aecApp1 "activedocument") "Utility")
     )
    (if (and (= aecSurf "")
      (> (vlax-get aecSurfs "count") 0)
         )
      (setq aecSurf (vlax-get (vlax-invoke aecSurfs "item" 0) "name"))
     ) ;; End if
    (if (= aecSurf "")
      (princ "\nNo surfaces defined, try again after creating a surface.")
      (progn
       (setq aecSurf (vlax-invoke aecSurfs "item" aecSurf))
       (while (setq pt# (getpoint "\nPoint along centerline: "))
   (setq e-n (vlax-invoke aecutil "xytoeastnorth" pt#))
   (setq selev (vlax-invoke aecSurf "getelevation" (car e-n) (cadr e-n)))
;;
;; Add/Subtract Elevation
;;
   (setq newelev (+ selev chelev))
;;
;;
  (setq IPT (getpoint "\nInsertion point: "))
  (setq ATR (rtos newelev 2 2))
  (command "INSERT" Addsurf:BLK IPT XSF YSF RTA ATR)
;;
;;
   )
      )
    )
  (setq objList (reverse '(acadObj1 aecApp1 aecProj aecSurfs aecSurf aecUtil)))
  (setq emsg (vl-catch-all-apply 'vlax-release-object 'objList))
  (vl-catch-all-error-message emsg)  
  (princ)
  )


[whdjr]

Just at a quick glance, since you are localizing xsf, ysf, and rta it's kind of overkill to check if they are equal to nil because they will always be nil.  Also because you set xsf and ysf equal to Hscale, don't even use the first two just use Hscale.  I decided to go ahead and change a little of it.  I am not too familiar with what your doing so I didn't change too much.  This is not criticism just some helpful thoughts.

Code: [Select]

(defun C:Addsurf (/   aecApp   aecDoc   PrefDoc  Hscale   RTA CTYP chelev  elevc
 aecProj  aecSurfs aecSurf  aecUtil  pt#      e-n selev newelev  IPT
 ATR   objList  emsg
)
  (setq aecApp (vla-getinterfaceobject
 (vlax-get-acad-object)
 "Aecc.Application"
)
aecDoc (vlax-get aecApp "ActiveDocument")
PrefDoc (vlax-get aecDoc "preferences")
Hscale (vlax-get PrefDoc "DatabaseScale")
RTA 0.0
  )
  (if Addsurf:BLK ;global variable
    (if (/= (setq CTYP (getstring T
 (strcat "\nBlock to Insert: <" Addsurf:BLK "> ")
      )
   )
   ""
)
      (setq Addsurf:BLK CTYP)
 ;If user presses enter then the global var is used.
    )
    (setq Addsurf:BLK (getstring "\nBlock to Insert: "))
  )
  ;;
  ;;
  (if chelev ;global variable
    (progn
      (setq chelev (rtos chelev))
      (setq chelev (atof
    (if (= (setq elevc (getstring (strcat "\nElevation Change: <" chelev "> ")))
   ""
)
      chelev
      elevc
    )
  )
      )
    )
    (setq chelev (atof (getstring "\nElevation Change: ")))
  )
  ;;
  ;;
  (setq aecProj (vlax-get aecApp "Activeproject")
aecSurfs (vlax-get aecProj "Surfaces")
aecSurf (vlax-get aecSurfs "Currentsurface")
aecUtil (vlax-get aecDoc "Utility")
  )
  (if (and (= aecSurf "")
  (> (vlax-get aecSurfs "count") 0)
      )
    (setq aecSurf (vlax-get (vlax-invoke aecSurfs "item" 0) "name"))
  )
  ;; End if
  (if (= aecSurf "")
    (princ
      "\nNo surfaces defined, try again after creating a surface."
    )
    (progn
      (setq aecSurf (vlax-invoke aecSurfs "item" aecSurf))
      (while (setq pt# (getpoint "\nPoint along centerline: "))
(setq e-n (vlax-invoke aecutil "xytoeastnorth" pt#))
(setq selev (vlax-invoke aecSurf "getelevation" (car e-n) (cadr e-n)))
;;
;; Add/Subtract Elevation
;;
(setq newelev (+ selev chelev))
;;
;;
(setq IPT (getpoint "\nInsertion point: "))
(setq ATR (rtos newelev 2 2))
(command "INSERT" Addsurf:BLK IPT Hscale Hscale RTA ATR)
;;
;;
      )
    )
  )
  (setq objList (reverse
 '(acadObj1 aecApp1 aecProj aecSurfs aecSurf aecUtil)
)
  )
  (if (setq emsg (vl-catch-all-apply 'vlax-release-object 'objList))
    (vl-catch-all-error-message emsg)
  )
  (princ)
)

[Jeff_M]

Dan,
It looks like Will found your biggest culprits for the crashing....you had 2 references to AeccApplication and you were only releasing one of them. Never use 2 references......you can do anything you want with only 1.

Second, check Will's release list....it looks like he may have invalid entries left behind.....

Third, put in some kind of error trap. If the user doesn't select a second point, Kablam!

Fourth, give the user some kind of reference as to where he is....Hint:
(setq IPT (getpoint pt# "\nInsertion point: "))