BIGAL Posted June 22, 2010 Share Posted June 22, 2010 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 Quote Link to comment Share on other sites More sharing options...
alanjt Posted June 22, 2010 Share Posted June 22, 2010 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)) ) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted June 22, 2010 Author Share Posted June 22, 2010 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. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted June 24, 2010 Author Share Posted June 24, 2010 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. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 16, 2010 Author Share Posted July 16, 2010 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") ) Quote Link to comment Share on other sites More sharing options...
alanjt Posted July 16, 2010 Share Posted July 16, 2010 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. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 21, 2010 Author Share Posted July 21, 2010 Sorry to bother you Alan any chance to paste a a copy here ? Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 30, 2010 Author Share Posted July 30, 2010 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. Quote Link to comment Share on other sites More sharing options...
alanjt Posted July 30, 2010 Share Posted July 30, 2010 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. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted January 19, 2011 Author Share Posted January 19, 2011 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 ) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted February 2, 2011 Author Share Posted February 2, 2011 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 ) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted September 4, 2011 Author Share Posted September 4, 2011 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.