(defun createvbolumeTIN
(surfacename layer stylename Base_tin Comp_tin /
*acad* c3d c3ddoc datastr names pfiles prodstring surf surfs tincreationdata verstring)
(vl-load-com)
(setq C3D (strcat "HKEY_LOCAL_MACHINE\\"
(if vlax-user-product-key
(vlax-user-product-key)
(vlax-product-key)
)
)
C3D (vl-registry-read C3D "Release")
verstring (substr C3D
1
(vl-string-search
"."
C3D
(+ (vl-string-search "." C3D) 1)
)
)
prodstring (strcat "AeccXUiLand.AeccApplication." verstring)
)
(setq datastr (strcat "AeccXLand.AeccTinVolumeCreationData." verstring))
(if (and (setq *acad* (vlax-get-acad-object))
(setq C3D (vla-getinterfaceobject *acad* prodstring))
(setq C3Ddoc (vla-get-activedocument C3D))
(setq surfs (vlax-get C3Ddoc 'surfaces))
(vlax-for surf surfs
(setq names (cons (vlax-get surf 'name) names))
)
(setq tincreationdata (vla-getinterfaceobject *acad* datastr))
)
(progn
;;make sure we don't try to use a duplicate name
(while (member surfacename names)
(setq surfacename (strcat surfacename "(1)"))
)
(vlax-put tincreationdata 'baselayer layer)
(vlax-put tincreationdata 'layer layer)
;;;
(vlax-put tincreationdata 'baseSurface Base_tin)
(vlax-put tincreationdata 'ComparisonSurface Comp_tin)
(vlax-put tincreationdata 'description "Surface from Lisp")
(vlax-put tincreationdata 'name surfacename)
(vlax-put tincreationdata 'style stylename)
;;style must exist!
(setq
surf (vlax-invoke-method surfs 'addtinsurface tincreationdata)
)
(vlax-invoke surf 'rebuild)
;; do whatever else is needed
(vlax-release-object tincreationdata)
(vlax-release-object surf)
(vlax-release-object surfs)
(vlax-release-object c3ddoc)
(vlax-release-object C3D)
)
)
(princ)
)