Author Topic: I broke it...  (Read 1472 times)

0 Members and 1 Guest are viewing this topic.

MSTG007

  • Gator
  • Posts: 2565
  • I can't remeber what I already asked! I need help!
I broke it...
« on: August 27, 2015, 07:29:03 AM »
I can not figure out what I did, but each time I try to run this routine, my whole session of CAD crashes. Great routine too.

Code: [Select]
(defun c:zm2st (/ *ACAD* C3D C3DDOC LOCATION NTWRK NTWRKS PROD PRODSTR PT STRC STRCNAME STRUCTURES)
(vl-load-com)
(setq prod (vlax-product-key))
(setq prodStr (strcat "AeccXUiPipe.AeccPipeApplication"
(cond ((vl-string-search "\\R17.0\\" prod)
       ".4.0"
      )
      ;;2007
      ((vl-string-search "\\R17.1\\" prod)
       ".5.0"

      )

      ;;2008

      ((vl-string-search "\\R17.2\\" prod)

       ".6.0"
      )

      ;;2009

      ((vl-string-search "\\R18.0\\" prod)

       ".7.0"
      )

      ;;2010

      ((vl-string-search "\\R18.1\\" prod)

       ".8.0"

      )

      ;;2011

      ((vl-string-search "\\R18.2\\" prod)

       ".9.0"
      )

      ;;2012

      ((vl-string-search "\\R19.0\\" prod)
       ".10.0"

      )

      ;;2013

      ((vl-string-search "\\R19.1\\" prod)

       ".10.3"

      )

      ;;2014
      (t "")

)

)

  )

  (if (and (setq *acad* (vlax-get-acad-object))

   (setq C3D (vla-getinterfaceobject *acad* prodStr))

   (setq C3Ddoc (vla-get-activedocument C3D))

      )

    (progn

      (setq ntwrks (vlax-get c3ddoc 'pipenetworks))

      (setq strcname (getstring "\nStructure name to zoom to: " t))

      (vlax-for ntwrk ntwrks

(if (not strc)

  (progn

    (vl-catch-all-apply '(lambda ()

    (setq structures (vlax-get ntwrk 'structures))

    (setq strc (vlax-invoke structures 'item strcname))

   )
      '())

  )

)

      )

      (if strc

(progn

  (setq location (vlax-get strc 'position))

  (setq pt (list (vlax-get location 'x) (vlax-get location 'y)))

(command "zoom" "c" pt "40")

)

(progn

  (princ (strcat "\nStructure \"" strcname "\" not found."))

)

      )

    )

  )

  (princ)

)
 

 

Civil3D 2020

Master_Shake

  • Swamp Rat
  • Posts: 1447
Re: I broke it...
« Reply #1 on: August 27, 2015, 08:22:55 AM »
Open it in VLIDE and step through the routine

Lee Mac

  • Seagull
  • Posts: 12726
  • London, England
Re: I broke it...
« Reply #2 on: August 27, 2015, 09:22:31 AM »
I have no access to C3D, but perhaps the following will prevent/reveal the error:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:zm2st ( / app c3d doc err loc nwk pos stc str sts )
  2.     (if
  3.         (and
  4.             (setq c3d
  5.                 (vl-catch-all-apply 'vla-getinterfaceobject
  6.                     (list (setq app (vlax-get-acad-object))
  7.                         (strcat "aeccxuipipe.aeccpipeapplication"
  8.                             (cond
  9.                                 (  
  10.                                     (cdr
  11.                                         (assoc (atof (getvar 'acadver))
  12.                                            '(
  13.                                                 (17.0 . ".4.0")
  14.                                                 (17.1 . ".5.0")
  15.                                                 (17.2 . ".6.0")
  16.                                                 (18.0 . ".7.0")
  17.                                                 (18.1 . ".8.0")
  18.                                                 (18.2 . ".9.0")
  19.                                                 (19.0 . ".10.0")
  20.                                                 (19.1 . ".10.3")
  21.                                             )
  22.                                         )
  23.                                     )
  24.                                 )
  25.                                 (   ""  )
  26.                             )
  27.                         )
  28.                     )
  29.                 )
  30.             )
  31.             (not (vl-catch-all-error-p c3d))
  32.         )
  33.         (progn
  34.             (if
  35.                 (or
  36.                     (and
  37.                         (vl-catch-all-error-p
  38.                             (setq err
  39.                                 (vl-catch-all-apply
  40.                                    '(lambda nil
  41.                                         (setq doc (vlax-get c3d 'activedocument)
  42.                                               nwk (vlax-get doc 'pipenetworks)
  43.                                         )
  44.                                     )
  45.                                 )
  46.                             )
  47.                         )
  48.                         (princ
  49.                             (strcat "\nError accessing activedocument/pipenetworks: "
  50.                                 (vl-catch-all-error-message err)
  51.                             )
  52.                         )
  53.                     )
  54.                     (null doc) (null nwk)
  55.                 )
  56.                 (if doc
  57.                     (princ "\nUnable to access pipenetworks property.")
  58.                     (princ "\nUnable to access activedocument property.")
  59.                 )
  60.                 (if (/= "" (setq str (getstring "\nStructure to zoom to: ")))
  61.                     (if
  62.                         (vl-catch-all-error-p
  63.                             (setq err
  64.                                 (vl-catch-all-apply
  65.                                     (function
  66.                                         (lambda nil
  67.                                             (vlax-for x nwk
  68.                                                 (if (null stc)
  69.                                                     (vl-catch-all-apply
  70.                                                         (function
  71.                                                             (lambda nil
  72.                                                                 (setq sts (vlax-get x 'structures)
  73.                                                                       stc (vlax-invoke sts 'item str)
  74.                                                                 )
  75.                                                             )
  76.                                                         )
  77.                                                     )
  78.                                                 )
  79.                                                 (if (and (= 'vla-object (type sts)) (not (vlax-object-released-p sts)))
  80.                                                     (progn
  81.                                                         (vlax-release-object sts)
  82.                                                         (setq sts nil)
  83.                                                     )
  84.                                                 )
  85.                                             )
  86.                                             (if stc
  87.                                                 (setq loc (vlax-get stc 'position)
  88.                                                       pos (list (vlax-get pos 'x) (vlax-get pos 'y))
  89.                                                 )
  90.                                                 (princ (strcat "\nStructure \"" str "\" not found."))
  91.                                             )
  92.                                         )
  93.                                     )
  94.                                 )
  95.                             )
  96.                         )
  97.                         (princ
  98.                             (strcat "\nUnable to obtain structure position: "
  99.                                 (vl-catch-all-error-message err)
  100.                             )
  101.                         )
  102.                         (if pos (vla-zoomcenter app (vlax-3D-point pos) 40))
  103.                     )
  104.                 )
  105.             )
  106.             (foreach obj (list loc stc nwk doc c3d)
  107.                 (if (and (= 'vla-object (type obj)) (not (vlax-object-released-p obj)))
  108.                     (vlax-release-object obj)
  109.                 )
  110.             )
  111.         )
  112.         (princ
  113.             (strcat "\nUnable to interface with C3D application"
  114.                 (if (vl-catch-all-error-p c3d)
  115.                     (strcat ": " (vl-catch-all-error-message c3d))
  116.                     "."
  117.                 )
  118.             )
  119.         )
  120.     )
  121.     (princ)
  122. )

Jeff_M

  • King Gator
  • Posts: 4042
  • C3D user & customizer
Re: I broke it...
« Reply #3 on: August 27, 2015, 10:40:41 AM »
Since that code was written I was shown a better way to get the Civil & Pipe objects. This code just ran fine in C3D2016 for me:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:zm2st (/         C3D       C3DDOC    LOCATION  NTWRK
  2.                 NTWRKS    PROD      PRODSTR   PT        STRC
  3.                 STRCNAME  STRUCTURES
  4.                )
  5.   (if (setq C3D    (strcat "HKEY_LOCAL_MACHINE\\"
  6.                            (if vlax-user-product-key
  7.                              (vlax-user-product-key)
  8.                              (vlax-product-key)
  9.                            )
  10.                    )
  11.             C3D    (vl-registry-read C3D "Release")
  12.             C3D    (substr
  13.                      C3D
  14.                      1
  15.                      (vl-string-search "." C3D (+ (vl-string-search "." C3D) 1))
  16.                    )
  17.             C3D    (vla-getinterfaceobject
  18.                      (vlax-get-acad-object)
  19.                      (strcat "AeccXUiPipe.AeccPipeApplication." C3D)
  20.                    )
  21.             C3Ddoc (vla-get-activedocument C3D)
  22.       )
  23.     (progn
  24.       (setq ntwrks (vlax-get c3ddoc 'pipenetworks))
  25.       (setq strcname (getstring "\nStructure name to zoom to: " t))
  26.       (vlax-for ntwrk ntwrks
  27.         (if (not strc)
  28.           (progn
  29.             (vl-catch-all-apply
  30.               '(lambda ()
  31.                  (setq structures (vlax-get ntwrk 'structures))
  32.                  (setq strc (vlax-invoke structures 'item strcname))
  33.                )
  34.               '()
  35.             )
  36.           )
  37.         )
  38.       )
  39.       (if strc
  40.         (progn
  41.           (setq location (vlax-get strc 'position))
  42.           (setq pt (list (vlax-get location 'x) (vlax-get location 'y)))
  43.           (command "zoom" "c" pt "40")
  44.         )
  45.         (progn
  46.           (princ (strcat "\nStructure \"" strcname "\" not found."))
  47.         )
  48.       )
  49.     )
  50.   )
  51.   (princ)
  52. )
  53.