Jump to content

Changing CIV3d contours simply


BIGAL

Recommended Posts

For a while now I have been trying to figure out how to change the civil 3d contour display simply without using the properties boxes which are a bit long winded. ie set up a toolbar with presets. The code below will find the surfaces in this case two surfaces two different contour intervals.

 

; application ver 6.0 is 2009 may need 7 or 8 ?
(Vl-load-com)
(setq surfs (vlax-get-property
(vlax-get-property 
(vlax-get-property 
(vla-getinterfaceobject (VLAX-GET-ACAD-OBJECT) 
"AeccXUiLand.AeccApplication.6.0" )
'ActiveDocument)
'Surfaces)
'style)
)
(setq ans "surfaces : ")
;display surface names
(vlax-for each surfs 
(setq name (vla-get-name each) )
(setq styname (vla-get-stylename each) )
(setq ans (strcat ans name styname))
)
(princ ans)


 

Doing a dump of the surface object reveals

 

Command:
Select object:
; IAeccTinSurface: IAeccTinSurface interface
; Property values:
;   Application (RO) = #<VLA-OBJECT IAeccApplication 0da15b18>
;   Boundaries (RO) = #<VLA-OBJECT IAeccSurfaceBoundaries 17a4b464>
;   Breaklines (RO) = #<VLA-OBJECT IAeccSurfaceBreaklines 17a4b07c>
;   ContourLabelGroups (RO) = #<VLA-OBJECT IAeccSurfaceContourLabelGroups 
0db04160>
;   Contours (RO) = #<VLA-OBJECT IAeccSurfaceContours 17a48d2c>
;   DefinitionProperties (RO) = #<VLA-OBJECT 
IAeccTinSurfaceDefinitionProperties 0da15a70>
;   DEMFiles (RO) = #<VLA-OBJECT IAeccSurfaceDEMFiles 17a4afdc>
;   Description = "Description"
;   DisplayName (RO) = "Surface1"
;   Document (RO) = #<VLA-OBJECT IAeccDocument 0d9d4880>
;   Handle (RO) = "55"
;   HasExtensionDictionary (RO) = 0
;   Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 1716a5dc>
;   Labels (RO) = #<VLA-OBJECT IAeccSurfaceLabels 0db04220>
;   Layer = "0"
;   Linetype = "ByLayer"
;   LinetypeScale = 1.0
;   Lineweight = -1
;   Material = "ByLayer"
;   Name = "Surface1"
;   ObjectID (RO) = 2127765160
;   ObjectName (RO) = "AeccDbSurfaceTin"
;   OutputTriangles (RO) = (217.536 314.67 100.0 266.123 403.035 100.0 ... )
;   OwnerID (RO) = 2127764496
;   PlotStyleName = "ByLayer"
;   PointFiles (RO) = #<VLA-OBJECT IAeccSurfacePointFiles 17a4b52c>
;   PointGroups (RO) = #<VLA-OBJECT IAeccSurfacePointGroups 17a48c64>
;   Points (RO) = (266.123 403.035 100.0 153.02 392.686 100.0 ... )
;   ShowToolTip = -1
;   Statistics (RO) = #<VLA-OBJECT IAeccTinSurfaceStatistics 0da15ae8>
;   Style = #<VLA-OBJECT IAeccSurfaceStyle 17bf7d90>
;   StyleName (RO) = "0.1 Contours"
;   SurfaceAnalysis (RO) = #<VLA-OBJECT IAeccSurfaceAnalysis 0da15878>

 

the critical lines are Style VLA-OBJECT IAeccSurfaceStyle 17bf7d90

and ; StyleName (RO) = "0.1 Contours"

 

Changing the contour interval changes the "Style" value and is then shown in Stylename.

 

I can not seem to get the Style as a variable in a vlax-get-style command then I want to change its value I believe using a put to one of my other contour settings.

 

I have attached a very simple contour dwg two surfaces & two contour intervals,

 

Any help would be appreciated once I get around the tree structure I am sure other Civ3D enhancements will follow.

conts2.dwg

Link to comment
Share on other sites

Straight out of my surface style change routine:

     (setq *Acad* (vlax-get-acad-object))
     (setq *AeccApp* (vla-getinterfaceobject
                       *Acad*
                       (strcat "AeccXUiLand.AeccApplication." appstr)
                     )
     )
     (setq *AeccDoc* (vlax-get *AeccApp* 'ActiveDocument))

     (vlax-for i (vlax-get *AeccDoc* 'SurfaceStyles)
       (setq lst (cons (cons (vla-get-name i) i) lst))
     )

surface.gif

Link to comment
Share on other sites

Alanjt thats exactly what I was trying to do we have about 7 different styles we use . You obviously appreciate the number of clicks and slider choices to be made just to change the contour display.

 

I would very much appreciate if you could supply the rest of the code including the form. Any changes I would provide back in return. Possibly a double box pick surface name and style. Most times we have one surface only so it would default to first surface.

 

As I said the next task would be to do the same for points display. You have given me the insight in how to get inside the application, the big hint is in the naming used 'surfacestyles v's the dump report of Style.

 

Where can you find the list of the variable names ? eg Stylename = name, the s on the end of surfacestyles I would never have got it.

Link to comment
Share on other sites

Alanjt could you provide a bit more help please I can get the surface names and the surface styles properties as per your and my code.

 

Could you please provide the code to change the style for a surface. I can do the rest with regards to creating a user interface.

 

Thanks for your help so far.

Link to comment
Share on other sites

  • 3 weeks later...

Help any one I know I am close just can not put my finger on it I have added a couple of lines at end tried different combos can not get it to work I know I need to do a "put" The dwg has two surfaces different names with two different contour styles. Either my code or AlanJt

 

(Vl-load-com)
(setq surfs (vlax-get-property
(vlax-get-property 
(vla-getinterfaceobject (VLAX-GET-ACAD-OBJECT) 
"AeccXUiLand.AeccApplication.6.0" )
'ActiveDocument)
'Surfaces
)
)
(setq ans "surfaces : ")
;display surface names
(vlax-for each surfs 
(setq name (vla-get-name each) )
(setq styname (vla-get-stylename each) )
(setq ans (strcat ans name styname))
)
(princ ans)

 

tried

;attemp1

(vlax-for each surfs (vlax-put-property 'SurfaceStyles "0.25 CONTOURS"))

 

;attempt2

(vlax-for each surfs (vlax-put-Surfaces 'SurfaceStyles "0.25 CONTOURS"))

 

Using alanjt code

(vlax-for i (vlax-get *AeccDoc* 'SurfaceS)

(setq lst2 (cons (cons (vla-get-name i) i) lst))

)

 

Gives the surfaces names

 

also tried

(vlax-for x (vlax-get *AeccDoc* 'SurfaceS)

(vlax-put-property 'SurfaceStyles "0.25 CONTOURS")

)

Link to comment
Share on other sites

Hey, I don't have the working version at home (only a test/tweak version), but as soon as I get in the office on Monday, I'll post you my working version.

Link to comment
Share on other sites

  • 2 weeks later...

Thanks Alan for your help showed a couple of guys here how it works and they were greatly impressed.

 

The display dialouge box is done brilliantly never thought about writing one as needed. written others to be used multiple times.

 

The one hiccup though and maybe its something you know about is that we turn off the contours/triangles normally whilst drafting this means can not use entsel.

 

With the code provided though I am looking at doing two command options (pull down menu or toolbar) one as is other to pick surface to turn on and then pick style. The other alternative is to do a dual list box styles and surfaces pick a surface and style to set including this way to turn off no surface pick means use 1st entry = 1 surface only anyway. It appears the only command lines that need changing are

(vlax-for x (setq ss (vla-get-activeselectionset *AeccDoc*))

(vlax-put x 'Style (cdr (assoc surface lst)))

 

adding gets the surface names

(vlax-for j (vlax-get *AeccDoc* 'SurfaceS)

(setq lst2 (cons (cons (vla-get-name j) j) lst2)))

 

Running the dialouge box twice could be a simple test method I seek your thought before I get the scissor out and cut and paste.

Link to comment
Share on other sites

I had planned on doing a version where you could select the available surfaces from a list (similar to core C3D's functionality), but I just haven't the chance and you were itching for the code. My weekends start on Thursday and I don't have Civil installed at home, so it'll be Monday before I can play, but I'll take a crack at it first thing Monday. eMail me and we'll work on this further.

Link to comment
Share on other sites

  • 5 months later...

Well a lot of water has passed by here in Aus but a new version of a simple contour display method has been achieved, I would like to thak Alanjt for his source code, the contour display is called by a shorthand keystroke CC (defun C:cc () (load "listselect")(load "changecontours5")) it allows for changing of display of one or more surfaces even if a surface is not currently displayed or to be turned off. A future version will be called by a toolbar menu. Any suggestions would be appreciated why did Autodesk make it so complicated in the first place.

 

LISTSELECT


(defun AT:ListSelect (title label height width multi lst / fn fo d item f)
 ;; List Select Dialog (Temp DCL list box selection, based on provided list)
 ;; title - list box title
 ;; label - label for list box
 ;; height - height of box
 ;; width - width of box
 ;; multi - selection method ["true": multiple, "false": single]
 ;; lst - list of strings to place in list box
 ;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite)
 (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w"))
 (foreach x (list (strcat "list_select : dialog { label = \"" title "\"; spacer;")
                  (strcat ": list_box { label = \"" label "\";" "key = \"lst\";")
                  (strcat "allow_accept = true; height = " (vl-princ-to-string height) ";")
                  (strcat "width = " (vl-princ-to-string width) ";")
                  (strcat "multiple_select = " multi "; } spacer; ok_cancel; }")
            )
   (write-line x fo)
 )
 (close fo)
 (new_dialog "list_select" (setq d (load_dialog fn)))
 (start_list "lst")
 (mapcar (function add_list) lst)
 (end_list)
 (setq item (set_tile "lst" "0"))
 (action_tile "lst" "(setq item $value)")
 (setq f (start_dialog))
 (unload_dialog d)
 (vl-file-delete fn)
 (if (= f 1)
   ((lambda (s / i s l)
      (while (setq i (vl-string-search " " s))
        (setq l (cons (nth (atoi (substr s 1 i)) lst) l))
        (setq s (substr s (+ 2 i)))
      )
      (reverse (cons (nth (atoi s) lst) l))
    )
     item
   )
 )
)

Changecontours5




 

changecontours5

;(defun c:Surface (/ appstr lst )
 ;; Assign new style to selected Civil 3D surfaces
 ;; Required Subroutines: AT:ListSelect
 ;; Alan J. Thompson, 06.22.10
 ;; Modified by Alan H Jan 2011
(vl-load-com)
(if ((lambda (vrsn)
       (cond
        ((vl-string-search "R17.2" vrsn) (setq appstr "6.0")) ;09
        ((vl-string-search "R18.0" vrsn) (setq appstr "7.0")) ;10
        ((vl-string-search "R18.1" vrsn) (setq appstr "8.0")) ;11
       ((alert "This version of C3D not supported!"))
       )
      )
      (vlax-product-key)
     )                         ; end if condition progn is true
     (progn
       (cond (*AeccDoc*)
         ((setq *AeccDoc*
           (vlax-get
             (cond (*AeccApp*)
               ((setq *AeccApp*
                 (vla-getinterfaceobject
                    (cond (*Acad*)
                    ((setq *Acad* (vlax-get-acad-object)))
                    )
                    (strcat "AeccXUiLand.AeccApplication." appstr)
                 )
                )
               )
             )
             'ActiveDocument
           )
          )
         )
       ) ; end main cond
     ) ; end progn
) ; end if vsrn
     
(vlax-for j (vlax-get *AeccDoc* 'SurfaceS)
;(princ (vla-get-name j))
(setq lst (cons (cons (vla-get-name j) j) lst))
) 
;if length of surfaces more than 1 else skip pick  if  0 then msg and exit
(setq lenlst (length lst))
(if (= lenlst 0)
   (progn
   (Getstring "\nYou have no surfaces press any key to exit")
   (exit)
   )
)

(if (= lenlst 1)
 (setq surfacepick (car (nth 0 lst)))  ; pull surface out of dotted pair
)
(if (> lenlst 1)
 (progn
 (setq surfacepick (car (AT:ListSelect
   "Set new surface "
   "Select surface name"
   10
   10
   "false"
   (vl-sort (mapcar (function car) lst) '<)
 )))
 ) ; end progn  
) ;end if
(setq lst2 lst)     ; make answer returned list2
(setq lst '())
(vlax-for i (vlax-get *AeccDoc* 'SurfaceStyles)
 (setq lst (cons (cons (vla-get-name i) i) lst))
)
(if (and lst
              (setq surface (car (AT:ListSelect
                                   "Set new surface style"
                                   "Select style"
                                   10
                                   10
                                   "false"
                                   (vl-sort (mapcar (function car) lst) '<)
                                 ) )
              )
           
             )
       (progn
       (vlax-for k (vlax-get *AeccDoc* 'SurfaceS)
    (if (= Surfacepick (vla-get-name k))             ;match surface
    (vlax-put k 'Style (cdr (assoc surface lst)))
                     ) ; end if
        )   ; end vlax-for
        )   ; end progn
)  ; end if
(setq lst '())
(setq surfacepick nil
         surface nil
         lenlst nil)
(princ)  ; exit quietly
;end of surface defun )

Link to comment
Share on other sites

  • 2 weeks later...

here is change point labels simply for anyone interested the guys in office here are very happy so much simpler

 

 ;; Assign new style to Civil 3D points
 ;; Required Subroutines: AT:ListSelect
 ;; Original code Alan J. Thompson, 06.22.10
 ;; Modified by Alan H Jan 2011
(vl-load-com)
(if ((lambda (vrsn)
       (cond
        ((vl-string-search "R17.2" vrsn) (setq appstr "6.0")) ;09
        ((vl-string-search "R18.0" vrsn) (setq appstr "7.0")) ;10
        ((vl-string-search "R18.1" vrsn) (setq appstr "8.0")) ;11
       ((alert "This version of C3D not supported!"))
       )
      )
      (vlax-product-key)
     )                         ; end if condition progn is true
     (progn
       (cond (*AeccDoc*)
         ((setq *AeccDoc*
           (vlax-get
             (cond (*AeccApp*)
               ((setq *AeccApp*
                 (vla-getinterfaceobject
                    (cond (*Acad*)
                    ((setq *Acad* (vlax-get-acad-object)))
                    )
                    (strcat "AeccXUiLand.AeccApplication." appstr)
                 )
                )
               )
             )
             'ActiveDocument
           )
          )
         )
       ) ; end main cond
     ) ; end progn
) ; end if vsrn
     
(vlax-for j (vlax-get *AeccDoc* 'Pointgroups)
(setq lst (cons (cons (vla-get-name j) j) lst))
) 
;if length of points more than 1 else skip pick  if  0 then msg and exit
(setq lenlst (length lst))
(if (= lenlst 0)
   (progn
   (Getstring "\nYou have no points press any key to exit")
   (exit)
   )
)

(if (= lenlst 1)
 (setq pointspick (car (nth 0 lst)))  ; pull points out of dotted pair
)
(if (> lenlst 1)
 (progn
 (setq pointspick (car (AT:ListSelect
   "Set new group "
   "Select points group"
   10
   10
   "false"
   (vl-sort (mapcar (function car) lst) '<)
 )))
 ) ; end progn  
) ;end if
(setq lst2 lst)     ; make answer returned list2
(setq lst '())
(vlax-for i (vlax-get *AeccDoc* 'Pointlabelstyles)
 (setq lst (cons (cons (vla-get-name i) i) lst))
)
(if (and lst
              (setq points (car (AT:ListSelect
                                   "Set new Point style"
                                   "Select style"
                                   10
                                   10
                                   "false"
                                   (vl-sort (mapcar (function car) lst) '<)
                                 ) )
              )
           
             )
       (progn
       (vlax-for k (vlax-get *AeccDoc* 'Pointgroups)
    (if (= pointspick (vla-get-name k))             ;match points
    (vlax-put k 'pointlabelstyle (cdr (assoc points lst)))
                     ) ; end if
        )   ; end vlax-for
        )   ; end progn
)  ; end if
(setq lst '())
(setq pointspick nil
         points nil
         lenlst nil)
(princ)  ; exit quietly
;end of points defun )

Link to comment
Share on other sites

  • 7 months later...

Finally a version that uses a toolbar for the contour choices rather than multi clicks.

 

It handles multi surfaces or if only 1 surface requires no user input.

 

Feed back from my staff is that its a better way than Autodesks .

 

Just download and read the readme its version 1 so any sugestions to improve would be appreciated.

 

Chcontourstoolbar.zip

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...