TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: MSTG007 on August 27, 2015, 07:29:03 AM

Title: I broke it...
Post by: MSTG007 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)

)
 

 



Title: Re: I broke it...
Post by: ChrisCarlson on August 27, 2015, 08:22:55 AM

Open it in VLIDE and step through the routine

Title: Re: I broke it...
Post by: Lee Mac 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. )
123. (vl-load-com) (princ)

Title: Re: I broke it...
Post by: Jeff_M 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.   (vl-load-com)
6.   (if (setq C3D    (strcat "HKEY_LOCAL_MACHINE\\"
7.                            (if vlax-user-product-key
8.                              (vlax-user-product-key)
9.                              (vlax-product-key)
10.                            )
11.                    )
12.             C3D    (vl-registry-read C3D "Release")
13.             C3D    (substr
14.                      C3D
15.                      1
16.                      (vl-string-search "." C3D (+ (vl-string-search "." C3D) 1))
17.                    )
18.             C3D    (vla-getinterfaceobject
19.                      (vlax-get-acad-object)
20.                      (strcat "AeccXUiPipe.AeccPipeApplication." C3D)
21.                    )
22.             C3Ddoc (vla-get-activedocument C3D)
23.       )
24.     (progn
25.       (setq ntwrks (vlax-get c3ddoc 'pipenetworks))
26.       (setq strcname (getstring "\nStructure name to zoom to: " t))
27.       (vlax-for ntwrk ntwrks
28.         (if (not strc)
29.           (progn
30.             (vl-catch-all-apply
31.               '(lambda ()
32.                  (setq structures (vlax-get ntwrk 'structures))
33.                  (setq strc (vlax-invoke structures 'item strcname))
34.                )
35.               '()
36.             )
37.           )
38.         )
39.       )
40.       (if strc
41.         (progn
42.           (setq location (vlax-get strc 'position))
43.           (setq pt (list (vlax-get location 'x) (vlax-get location 'y)))
44.           (command "zoom" "c" pt "40")
45.         )
46.         (progn
47.           (princ (strcat "\nStructure \"" strcname "\" not found."))
48.         )
49.       )
50.     )
51.   )
52.   (princ)
53. )
54.